view lisp/org/org-mks.el @ 110410:f2e111723c3a

Merge changes made in Gnus trunk. Reimplement nnimap, and do tweaks to the rest of the code to support that. * gnus-int.el (gnus-finish-retrieve-group-infos) (gnus-retrieve-group-data-early): New functions. * gnus-range.el (gnus-range-nconcat): New function. * gnus-start.el (gnus-get-unread-articles): Support early retrieval of data. (gnus-read-active-for-groups): Support finishing the early retrieval of data. * gnus-sum.el (gnus-summary-move-article): Pass the move-to group name if the move is internal, so that nnimap can do fast internal moves. * gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for nnimap usage. * nnimap.el: Rewritten. * nnmail.el (nnmail-inhibit-default-split-group): New internal variable to allow the mail splitting to not return a default group. This is useful for nnimap, which will leave unmatched mail in the inbox. * utf7.el (utf7-encode): Autoload. Implement shell connection. * nnimap.el (nnimap-open-shell-stream): New function. (nnimap-open-connection): Use it. Get the number of lines by using BODYSTRUCTURE. (nnimap-transform-headers): Get the number of lines in each message. (nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the number of lines. Not all servers return UIDNEXT. Work past this problem. Remove junk from end of file. Fix typo in "bogus" section. Make capabilties be case-insensitive. Require cl when compiling. Don't bug out if the LIST command doesn't have any parameters. 2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change) * nnimap.el (nnimap-get-groups): Don't bug out if the LIST command doesn't have any parameters. (mm-text-html-renderer): Document gnus-article-html. 2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix) * mm-decode.el (mm-text-html-renderer): Document gnus-article-html. * dgnushack.el: Define netrc-credentials. If the user doesn't have a /etc/services, supply some sensible port defaults. Have `unseen-or-unread' select an unread unseen article first. (nntp-open-server): Return whether the open was successful or not. Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ). Save result so that it doesn't say "failed" all the time. Add ~/.authinfo to the default, since that's probably most useful for users. Don't use the "finish" method when we're reading from the agent. Add some more nnimap-relevant agent stuff to nnagent.el. * nnimap.el (nnimap-with-process-buffer): Removed. Revert one line that was changed by mistake in the last checkin. (nnimap-open-connection): Don't error out when we can't make a connection nnimap-related changes to avoid bugging out if we can't contact a server. * gnus-start.el (gnus-get-unread-articles): Don't try to scan groups from methods that are denied. * nnimap.el (nnimap-possibly-change-group): Return nil if we can't log in. (nnimap-finish-retrieve-group-infos): Make sure we're not waiting for nothing. * gnus-sum.el (gnus-select-newsgroup): Indent.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Sat, 18 Sep 2010 10:02:19 +0000
parents a150e8a14679
children 5cb272c831e8
line wrap: on
line source

;;; org-mks.el --- Multi-key-selection for Org-mode

;; Copyright (C) 2010  Free Software Foundation, Inc.

;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 7.01
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; Commentary:
;; 

;;; Code:

(require 'org)
(eval-when-compile
  (require 'cl))

(defun org-mks (table title &optional prompt specials)
  "Select a member of an alist with multiple keys.
TABLE is the alist which should contain entries where the car is a string.
There should be two types of entries.

1. prefix descriptions like (\"a\" \"Description\")
   This indicates that `a' is a prefix key for multi-letter selection, and
   that there are entries following with keys like \"ab\", \"ax\"...

2. Selectable members must have more than two elements, with the first
   being the string of keys that lead to selecting it, and the second a
   short description string of the item.

The command will then make a temporary buffer listing all entries
that can be selected with a single key, and all the single key
prefixes.  When you press the key for a single-letter entry, it is selected.
When you press a prefix key, the commands (and maybe further prefixes)
under this key will be shown and offered for selection.

TITLE will be placed over the selection in the temporary buffer,
PROMPT will be used when prompting for a key.  SPECIAL is an alist with
also (\"key\" \"description\") entries.  When one of these is selection,
only the bare key is returned."
  (setq prompt (or prompt "Select: "))
  (let (tbl orig-table dkey ddesc des-keys allowed-keys
	    current prefix rtn re pressed buffer (inhibit-quit t))
    (save-window-excursion
      (setq buffer (org-switch-to-buffer-other-window "*Org Select*"))
      (setq orig-table table)
      (catch 'exit
	(while t
	  (erase-buffer)
	  (insert title "\n\n")
	  (setq tbl table
		des-keys nil
		allowed-keys nil)
	  (setq prefix (if current (concat current " ") ""))
	  (while tbl
	    (cond
	     ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1))
	      ;; This is a description on this level
	      (setq dkey (caar tbl) ddesc (cadar tbl))
	      (pop tbl)
	      (push dkey des-keys)
	      (push dkey allowed-keys)
	      (insert prefix "[" dkey "]" "..." "  " ddesc "..." "\n")
	      ;; Skip keys which are below this prefix
	      (setq re (concat "\\`" (regexp-quote dkey)))
	      (while (and tbl (string-match re (caar tbl))) (pop tbl)))
	     ((= 2 (length (car tbl)))
	      ;; Not yet a usable description, skip it
	      )
	     (t
	      ;; usable entry on this level
	      (insert prefix "[" (caar tbl) "]" "     " (nth 1 (car tbl)) "\n")
	      (push (caar tbl) allowed-keys)
	      (pop tbl))))
	  (when specials
	    (insert "-------------------------------------------------------------------------------\n")
	    (let ((sp specials))
	      (while sp
		(insert (format "[%s]     %s\n"
				(caar sp) (nth 1 (car sp))))
		(push (caar sp) allowed-keys)
		(pop sp))))
	  (push "\C-g" allowed-keys)
	  (goto-char (point-min))
	  (if (not (pos-visible-in-window-p (point-max)))
	      (org-fit-window-to-buffer))
	  (message prompt)
	  (setq pressed (char-to-string (read-char-exclusive)))
	  (while (not (member pressed allowed-keys))
	    (message "Invalid key `%s'" pressed) (sit-for 1)
	    (message prompt)
	    (setq pressed (char-to-string (read-char-exclusive))))
	  (when (equal pressed "\C-g")
	    (kill-buffer buffer)
	    (error "Abort"))
	  (when (and (not (assoc pressed table))
		     (not (member pressed des-keys))
		     (assoc pressed specials))
	    (throw 'exit (setq rtn pressed)))
	  (unless (member pressed des-keys)
	    (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table))
					   orig-table))))
	  (setq current (concat current pressed))
	  (setq table (mapcar
		       (lambda (x)
			 (if (and (> (length (car x)) 1)
				  (equal (substring (car x) 0 1) pressed))
			     (cons (substring (car x) 1) (cdr x))
			   nil))
		       table))
	  (setq table (remove nil table)))))
    (when buffer (kill-buffer buffer))
    rtn))

(provide 'org-mks)

;; arch-tag: 4ea90d0e-c6e4-4684-bd61-baf878712f9f

;;; org-mks.el ends here