[Mew-dist 15214] mew-mlm.el 0.1w (experimental release)
sen_ml at example.com
sen_ml at example.com
2000年 11月 29日 (水) 19:02:11 JST
mew-mlm.el をアップデートしました。
メーリングリストアーカイブへのアクセスをちょっと楽にしてくれる
mew-mlm-archive
若干の mew-mlm-master-alist の構造変更
bug fixes and refactoring
その他
-------------- next part --------------
;;; mew-mlm.el -- mailing list mgmt support
;; Author: Sen Nagata <sen at example.com>
;; Keywords: Mew, mailing list management
;; Version: 0.1w
;; Note: Some of this code is based on code in Mew.
;; WARNING:
;;
;; structure of `mew-mlm-master-alist' changed in version 0.1t.
;; `filter-info' is no longer a cons cell. it is now a string. see
;; documentation of `mew-mlm-make-entry' for details. it should be pretty
;; easy to update your data manually. n.b. i recommend backing up
;; your data before you mess w/ it. search for "UPGRADE INFO:" in this
;; file, there are some instructions there to help w/ the transition
;; should you need them.
;; Prerequisites:
;;
;; Emacs (tested w/ FSF Emacs 20.7, don't know about others)
;; Mew-1.95bX (X >= 78)
;; mew-browse.el (see contrib for Mew)
;; Usage:
;;
;; 1) put this file in your load-path
;;
;; 2) put:
;;
;; (add-hook 'mew-init-hook
;; '(lambda ()
;; (require 'mew-mlm)))
;;
;; in your .emacs.
;;
;; 3) to get Mew to create messages based on mailto: urls, appropriately
;; set up `browse-url-browser-function'. e.g. put:
;;
;; (setq browse-url-browser-function
;; '(("^mailto:" . mew-browse-url-mailto)
;; ("^http:" . browse-url-netscape) ; though i use w3
;; ("." . find-file)))
;;
;; in your .emacs. Note that `browse-url.el' ships w/ Emacs.
;; Commands and functions to try:
;;
;; Mailing list information management commands
;;
;; `mew-mlm-add-entry-via-guess-interactively'
;; `mew-mlm-edit-entry-via-guess-interactively'
;; `mew-mlm-edit-entry-interactively'
;; `mew-mlm-delete-entry-interactively'
;;
;; Mailing list interaction commands
;;
;; `mew-mlm-help'
;; `mew-mlm-unsubscribe'
;; `mew-mlm-subscribe'
;; `mew-mlm-post'
;; `mew-mlm-owner'
;; `mew-mlm-archive'
;;
;; Search-Mark commands
;;
;; `mew-mlm-search-mark-via-list-choice'
;; `mew-mlm-search-mark-via-guess'
;;
;; Refile-Guess function:
;;
;; `mew-refile-guess-by-ml'
;;
;; Note: There is now a submenu in the Mew menu from which you can
;; access some of these commands.
;; NEAR-TERM TODO:
;;
;; -url-escape search terms. really need something like url.el for this.
;;
;; -consider custom prompt functions for each field in entry. e.g. when
;; prompting for parents, limit possibilities to existing keys in
;; `mew-mlm-master-alist'.
;;
;; -store values to help construct urls to perform searches of archives.
;; support multiple locations to search?
;;
;; -additional list action functions:
;;
;; -search local folder
;;
;; -functions which guess list first, then perform list actions
;;
;; -test ;-)
;;
;; MEDIUM-TERM TODO:
;;
;; -split this code into multiple files?
;;
;; -additional keybindings and menus
;;
;; -want a nicer user interface for manipulating the contents of
;; mew-mlm-master-alist -- e.g. widget-based. it seems like forms mode
;; ought to handle lisp data structures...alternatively, create a
;; specific mode (cf. mhc)
;;
;; -check user input for list-* fields. e.g. don't accept strings that
;; don't contain urls, for instance. how about for other fields?
;;
;; -for guessing possible values for creating a new entry, consider
;; providing alternatives for each field using completion on seemingly
;; meaningful values extracted from message
;;
;; -for replacement of an existing entry, consider comparing the new
;; entry contents w/ the old entry contents. if they are the same,
;; there's no need to change anything.
;;
;; LONG-TERM TODO:
;;
;; -function which tries to extract ml info from help messages for
;; various mailing list packages. e.g. with cursor on a help message in
;; summary mode, execute `mew-mlm-merge-unsubscribe-info-from-message'
;; or some such. is it a good idea to try to merge multiple pieces of
;; info (e.g. unsubscribe info and subscribe info)?
;;
;; -store values to point to other entries for handling lists that split,
;; move machines, change mailing list software, etc. note that this will
;; require altering the functions which manipulate entries in
;; `mew-mlm-master-alist' in order to maintain integrity of "associations".
;; e.g. when removing an entry, need to do something about all entries
;; that "point to" the entry about to be removed. ("parents" info)
;;
;; -fetching and importing archives
;;
;; -add relevant `mew-summary-msg' etc. macros to appropriate places
;;
;; UNKNOWN TODO:
;;
;; -how about sort by ml? why do this? because then in a huge inbox,
;; you can do:
;;
;; 1) sort by ml
;; 2) `mew-summary-mark-make-thread'
;;
;; and then all threads for related mailing lists will be together.
;; consider using:
;;
;; mewls -f list-id,x-mailing-list,x-ml-name,mailing-list,sender +<folder>
;;
;; to get necessary information to perform sorting by ml. note that it
;; may be necessary to add more fields to the csv list of fields (located
;; after the -f) - so perhaps the csv list should be dynamically built
;; based on examining elements of `mew-mlm-guess-alist'?
;;
;; -some way to check whether filter-info is appropriate? e.g. checking
;; the value against any message under inspection while guessing.
;;
;; -consider placing some kind of string that identifies the mailing list
;; in the separator line for threaded display (if applicable)
;;
;; -consider code to merge value of `mew-refile-guess-alist' w/ that
;; produced by `mew-mlm-make-refile-guess-alist'
;;
;; -accumulate list admin address info in entry so admin messages can
;; also be refiled easily?
;;
;; -option for not saving changes to `mew-mlm-master-alist'?
;;
;; -function to check the contents of `mew-mlm-master-alist' and report
;; on contents (e.g. number of entries, missing info, possible
;; inconsistencies, etc.)
;;
;; -currently have entry selectors which get passed entries as arguments.
;; would it be better to have entry selectors which get passed keys? how
;; about having both?
;;
;; -rewrite code using more functions from Mew
;;
;; -providing ability to choose from various values via completion is
;; good. however, it would be nice to be able to indicate some kind of
;; priority or preference among choices. cf. items further to the left
;; in a list are considered better choices in RFC 2369 header values.
;;
;; -list status? defunct, alive, etc.
;;
;; -subscription status? subscribed, unsubscribed, etc.
;;
;; -making a version of this that's usable from other mail clients in
;; addition to mew
;;
;; -import/export functions to an external data format -- XML for
;; non-emacs mail clients? note: issue of exporting sensitive data:
;; auth-info and some (un)subscription info contain user addresses and/or
;; names. could decide not to store the info in `mew-mlm-master-alist',
;; but instead as attachments when the editing mode is complete...
;;
;; -does it make sense to suggest that `mew-browse-url-mailto' handle
;; urls enclosed in brackets? probably not. may be a new function
;; to operate on objects near/around point.
;;
;; -for a function like `mew-mlm-unsubscribe', could decide not to show
;; items that don't have unsubscribe info (in completion lists for example)
;;
;; -editing of filter information. specific mode for editing and
;; viewing (cf. mhc) should take care of this concern?
;;
;; -provide some way of viewing contents of `mew-mlm-master-alist'.
;; specific mode for editing and viewing (cf. mhc) should take care of
;; this concern?
;;
;; -function for adding entry from scratch w/o guessing. specific mode
;; for editting and viewing (cf. mhc) should take care of this concern?
;;
;; -store folder to refile into?
;;
;; -for folder naming, perhaps allow the calculated value to be overridden
;; by a stored value. some list-ids are long; will that cause any problems
;; (limit of 255 chars)? ponder how to deal w/ changes in name of
;; key for list...
;;
;; -folder renaming potentially affects information stored in a number of
;; places. some of these are:
;;
;; .mew-folder-list
;; .mew-folder-alist
;; .mew-refile-msgid-alist
;; .mew-refile-from-alist
;;
;; if you don't think of these things as a "log", changing their contents
;; doesn't seem too bad. other things that may need to be modified:
;;
;; mew-refile-guess-alist
;; mew-sort-default-key-alist
;;
;; starting to feel like having human-readable/writable names which
;; provide one level of indirection might be nicer from a "renaming
;; underlying directory name" point-of-view...
;;
;; -edit .mew-alias mode?
;; WISHES:
;;
;; -various emacsen should bundle something like url.el
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; dependencies
(eval-when-compile
(require 'mew)
(require 'mew-browse)) ; for `mew-browse-url-mailto'
; (see SRC/contrib)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; variable and constant definitions
(defvar mew-mlm-master-alist nil
"Alist for storing mailing list information.
Each key is a string identifying a single mailing list. Each associated
value stores information for a single mailing list.
See the definition of `mew-mlm-make-entry' for structural details
of each entry.
Note that the alist is initialized from and stored in
`mew-mlm-master-alist-file'.
Note: expect the stored data format to change a bit.")
(defvar mew-mlm-master-alist-file ".mew-mlm-master-alist"
"File for initializing and storing `mew-mlm-master-alist'.")
(defvar mew-mlm-guess-alist nil
"Constructed alist for storing guess information.
This alist is constructed from `mew-mlm-master-alist'. It's integrity should
be maintained by the code in this file. It is not intended to altered
directly.")
(defvar mew-mlm-folder-prefix "+ml/"
"Prefix string used to construct the folder associated with a particular
mailing list.
For a given list, `mew-mlm-compute-folder-name' is used to compute the
corresponding folder. Change this prefix string or redefine
`mew-mlm-folder-name' to change folder name computing behavior.
`mew-mlm-entry:folder' determines the folder associated with a particular
mailing list. Currently, the function calls `mew-mlm-computer-folder-name'.
To change folder naming behavior, change `mew-mlm-entry:folder' -- e.g.
a stored value for a folder name could be queried and if that doesn't
exist, a folder name could be computed.")
(defconst mew-mlm-search-term-place-holder "MLM_SEARCH_TERM"
"Constant string embedded in each element of the search list for an entry.
This string value is replaced with the search term in order to create
a url for use in querying remote archives (web-only?).")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; secondary storage (persistence) functions
(defun mew-mlm-load-master-alist ()
"Load `mew-mlm-master-alist' from `mew-mlm-master-alist-file'."
(interactive)
(setq mew-mlm-master-alist (mew-lisp-load mew-mlm-master-alist-file)))
(defun mew-mlm-save-master-alist ()
"Save `mew-mlm-master-alist' to `mew-mlm-master-alist-file'."
(interactive)
(mew-lisp-save mew-mlm-master-alist-file mew-mlm-master-alist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; constructors and selectors for entries of `mew-mlm-master-alist'
;; no mutators?
;; expect this to change (number and type of fields)
(defun mew-mlm-make-entry (key
help unsubscribe subscribe post owner archive
filter-info auth-info search-list parents)
"Construct an entry from arguments.
KEY is a string to identify the entry. One possible choice would be
the List-Id value. This might not be the best choice, but it's what
will be used for the moment.
HELP, UNSUBSCRIBE, SUBSCRIBE, POST, OWNER, and ARCHIVE are lists of
strings containing angle-bracket enclosed URLs. These arguments
represent the corresponding List-* header values from RFC 2369.
An example value for POST is \"<mailto:mew-dist at example.com>\".
FILTER-INFO is a string. It consists of a mail header name (includes
colon) followed by a corresponding mail header value (actually a
substring of a full value is probably the most practical) that is used
to identify which mailing list a particular message is associated
with.
AUTH-INFO is a string. It contains user authentication info for the
given list. The format of the string is free-form for the moment.
For example, it might contain a user name and password.
SEARCH-LIST is a list. Each element is a cons cell. The car and cdr
are strings that are concatenated on the left and right sides of a
URL-escaped search string to form a URL (HTTP being the main use) that
when accessed should return search results.
PARENTS is a list. Each element is a string corresponding to the key
of some other \"parent\" entry in `mew-mlm-master-alist'. The purpose of
this field is to provide a means of supporting associations between lists
which are historically related. Examples of historical relations are:
1) A list was moved from one machine to another, and the machine's
DNS name was changed. Consequently, the List-Id value changes.
2) Software used to host a list was changed. Consequently, List-*
information changed.
3) List splits into two pieces.
4) The membership from two mailing lists was merged into one list.
Note that SEARCH-LIST and PARENTS functionality is currently
unimplemented.
This is a low-level utility function intended for use by other functions."
(cons key (list (cons "help" help)
(cons "unsubscribe" unsubscribe)
(cons "subscribe" subscribe)
(cons "post" post)
(cons "owner" owner)
(cons "archive" archive)
(cons "filter-info" filter-info)
(cons "auth-info" auth-info)
(cons "search-list" search-list)
(cons "parents" parents))))
;; the selectors could probably all be defined via macros -- but edebug
;; usage becomes complicated, so forget it.
(defun mew-mlm-entry:key (entry)
(car entry))
;; TODO: rewrite selectors below in terms of this function?
(defun mew-mlm-entry-field (entry field-name)
(cdr (assoc field-name (cdr entry))))
(defun mew-mlm-entry:help (entry)
(cdr (assoc "help" (cdr entry))))
(defun mew-mlm-entry:unsubscribe (entry)
(cdr (assoc "unsubscribe" (cdr entry))))
(defun mew-mlm-entry:subscribe (entry)
(cdr (assoc "subscribe" (cdr entry))))
(defun mew-mlm-entry:post (entry)
(cdr (assoc "post" (cdr entry))))
(defun mew-mlm-entry:owner (entry)
(cdr (assoc "owner" (cdr entry))))
(defun mew-mlm-entry:archive (entry)
(cdr (assoc "archive" (cdr entry))))
(defun mew-mlm-entry:filter-info (entry)
(cdr (assoc "filter-info" (cdr entry))))
(defun mew-mlm-entry:auth-info (entry)
(cdr (assoc "auth-info" (cdr entry))))
(defun mew-mlm-entry:search-list (entry)
(cdr (assoc "search-list" (cdr entry))))
(defun mew-mlm-entry:parents (entry)
(cdr (assoc "parents" (cdr entry))))
;; TODO: check argument values using regexes?
(defun mew-mlm-make-filter-info (header-name header-value)
"Constructor for filter information.
Returns a string. See documentation of `mew-mlm-make-entry' for details."
(concat header-name " " header-value))
(defun mew-mlm-filter-info:header-name (filter-info)
(if (string-match "^\\([^ \t:]+:\\)" filter-info)
(match-string 1 filter-info)
(error "Error in structure of filter-info: `%S'." filter-info)))
(defun mew-mlm-filter-info:header-value (filter-info)
(if (string-match "^[^ \t:]+:[ \t]+\\([^ \t].*\\)$" filter-info)
(match-string 1 filter-info)
(error "Error in structure of filter-info: `%S'." filter-info)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; folder naming
;; TODO: first attempt at naming folders
(defun mew-mlm-compute-folder-name (entry)
(concat mew-mlm-folder-prefix (mew-mlm-entry:key entry)))
(defun mew-mlm-entry:folder (entry)
;; TODO: could check for stored value before computing
(mew-mlm-compute-folder-name entry))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; string manipulation functions
;; TODO: perhaps should return nil instead of calling `error' for functions
;; in this section
;; TODO: figure out when to use `error' and when to use `message'
(defun mew-mlm-extract-abes-from-string (string)
"Extract an abes (angle-bracket-enclosed string) from STRING."
(if (string-match "\\(<[^>]+>\\)" string)
(match-string 1 string)
(error "`%s' does not appear to contain an angle-bracket-enclosed string."
string)))
(defun mew-mlm-strip-enclosing-angle-brackets (abes)
"Strip enclosing angle brackets from ABES (angle-bracket-enclosed string)."
(if (string-match "^<\\([^>]+\\)>$" abes)
(match-string 1 abes)
(error "`%s' does not appear to be an angle-bracket-enclosed string."
abes)))
;; TODO: should work for most simple cases
(defun mew-mlm-extract-address-from-string (string)
"Extract an email address from STRING."
(if (string-match "<\\([^@]+@[^@]+\\)>" string)
(match-string 1 string)
(if (string-match "\\([^ \t@<]+@[^ \t@>]+\\)" string)
(match-string 1 string)
(error "`%s' does not appear to contain an address." string))))
;; TODO: quick hack -- haven't checked standards
(defun mew-mlm-make-list-id-from-address (address)
"Convert ADDRESS into a list-id value.
ADDRESS is a simple email address (i.e. user at example.com).
Returns a list-id value on success, nil otherwise."
(if (string-match "^\\([^@]+\\)@\\([^@]+\\)$" address)
(concat (match-string 1 address)
"."
(match-string 2 address))
nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; prompting-related functions
(defun mew-mlm-string-to-list (string)
"Convert a comma-separated string into a list."
(split-string string ",[ \t]+"))
(defun mew-mlm-list-to-string (list)
"Convert a list into a comma-separated list."
(mapconcat (lambda (elt) elt) list ", "))
(defun mew-mlm-list-to-alist (list)
"Convert LIST into an alist.
Each element of LIST becomes a key in alist. Each value associated with
each key is nil."
(mapcar (lambda (elt)
(cons elt nil))
list))
(defun mew-mlm-prompt-for-string (prompt default)
"Prompt user for a string value represented as a string.
PROMPT is the minibuffer prompt. DEFAULT is a default string."
(read-from-minibuffer prompt default))
;; TODO: consider possible "escaping commas (separators)" issue
(defun mew-mlm-prompt-for-list (prompt default-list)
"Prompt user for a list value represented as a string.
PROMPT is the minibuffer prompt. DEFAULT-LIST is a list of values used
to create a default string.
The string is split on commas to create multiple elements for a list.
By using commas, the user can express multiple values as a string.
Spaces are not a good choice because individual values are likely to contain
them."
(mew-mlm-string-to-list
(read-from-minibuffer prompt (mew-mlm-list-to-string default-list))))
;; TODO: probably ok to allow list to have only one element
(defun mew-mlm-prompt-from-list-with-default (prompt list default)
"Prompt user for a choice from LIST.
PROMPT is used to construct the prompt.
DEFAULT is displayed and used as a default value.
Supports completion."
(if (and (not (null list)) (listp list))
(completing-read
(format (concat prompt " (%s): ") default)
(mew-mlm-list-to-alist list)
nil t nil nil default)
(error "List empty or argument not list.")))
(defun mew-mlm-prompt-for-header-line (prompt default)
"Prompt user for a header line.
PROMPT is used as a prompt.
DEFAULT is displayed and used as a default value.
Returns a cons cell if successful. The car is the header name and the
cdr is the header value.
If unsuccessful at reading a proper header line, return nil.
Think of a header line as a complete header line from a mail message."
(let* ((input
(read-from-minibuffer prompt default nil nil nil default))
name value)
(if (string-match "\\([^:]+:\\)[ ]+\\([^ ]+.*\\)" input)
(cons (match-string 1 input)
(match-string 2 input))
nil)))
(defun mew-mlm-prompt-for-key (&optional key-should-exist default-key)
"Prompt for a key to use for `mew-mlm-master-alist'.
If KEY-SHOULD-EXIST is non-nil, the user-specified key must exist in
`mew-mlm-master-alist'. If KEY-SHOULD-EXIST is nil, the key must not
already exist in `mew-mlm-master-alist'."
(let ((key (or default-key ""))
key-exists key-good)
(while (not key-good)
(setq key
(cond (key-should-exist
(completing-read "Existing key: " mew-mlm-master-alist
nil t key nil key))
((not key-should-exist)
(read-from-minibuffer "New key: " key))
(t
(error "Should not reach this point in code."))))
(setq key-exists
(mew-mlm-key-exists-p key))
(if (equal key "")
(message "The empty string is not allowed as a key.")
(cond (key-should-exist
(if key-exists
(setq key-good t)
(message "The key should exist already, but it does not.")
(sit-for 1)))
((not key-should-exist)
(if (not key-exists)
(setq key-good t)
(message "That key exists already.")
(sit-for 1)))
(t
(error "Should not reach this point in the code.")))))
key))
(defun mew-mlm-prompt-for-new-key ()
"Prompt for a new key to use for `mew-mlm-master-alist'."
(mew-mlm-prompt-for-key nil))
(defun mew-mlm-prompt-for-existing-key (&optional default-key)
"Prompt for an existing key in `mew-mlm-master-alist'.
Optional argument DEFAULT-KEY is used as a default."
(mew-mlm-prompt-for-key t default-key))
(defun mew-mlm-prompt-for-list-action ()
""
)
(defun mew-mlm-prompt-for-filter-info (default)
"Prompt for filter information using DEFAULT as a default value.
See the documentation for `mew-mlm-make-entry' for the form of filter-info."
(let ((filter-info default)
filter-verified)
(while (not filter-verified)
(setq filter-info
(read-from-minibuffer "Filter info: " filter-info))
;; TODO: is this really an appropriate regex?
(if (string-match "^[^ \t:]+:[ \t]+" filter-info)
(setq filter-verified t)
(message "That is not an appropriate value for filter-info.")
(sit-for 1)))
filter-info))
;; actually would be nice to have crm.el here...
(defun mew-mlm-prompt-for-parents ()
"Prompt for a list of parents.
Each parent is represented as a key value from `mew-mlm-master-alist'."
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; functions related to manipulating `mew-mlm-master-alist'
(defun mew-mlm-get-entry (key)
"Retrieve entry keyed to KEY from `mew-mlm-master-alist'.
This is a low-level utility function intended for use by other functions."
(let ((entry (assoc key mew-mlm-master-alist)))
(if (not entry)
(error "There is no entry with key `%s'." key)
entry)))
(defun mew-mlm-key-exists-p (key)
"Check existence for entry keyed to KEY.
If entry exists, return t, otherwise return nil."
(if (assoc key mew-mlm-master-alist)
t
nil))
(defun mew-mlm-delete-entry (key)
"Delete entry keyed to KEY from `mew-mlm-master-alist'.
This is a low-level utility function intended for use by other functions."
(let ((entry (mew-mlm-get-entry key)))
(if entry
(progn
;; see doc for `delq' for explanation of `setq' in following line
(setq mew-mlm-master-alist (delq entry mew-mlm-master-alist))
(setq mew-mlm-guess-alist (mew-mlm-make-guess-alist)))
;; redundant given the definition of `mew-mlm-get-entry'?
(error "There is no entry with key `%s'." key))))
(defun mew-mlm-add-new-entry (entry)
"Add a new entry to `mew-mlm-master-alist'.
This is a low-level utility function intended for use by other functions."
(if (assoc (car entry) mew-mlm-master-alist)
(error "An entry with the key `%s' already exists." (car entry))
(progn
(setq mew-mlm-master-alist
(cons entry mew-mlm-master-alist))
(setq mew-mlm-guess-alist (mew-mlm-make-guess-alist)))))
(defun mew-mlm-replace-entry (from-entry to-entry)
"Replace entry FROM-ENTRY with entry TO-ENTRY in `mew-mlm-master-alist'.
This is a low-level utility function intended for use by other functions."
;; see doc for `delq' for explanation of `setq' in following line
(setq mew-mlm-master-alist
(delq from-entry mew-mlm-master-alist))
(setq mew-mlm-master-alist
(cons to-entry mew-mlm-master-alist))
(setq mew-mlm-guess-alist (mew-mlm-make-guess-alist)))
;; TODO: decide whether second argument should be optional
(defun mew-mlm-copy-and-morph-entry (entry key-should-exist)
"Allow the user to create a new entry based on ENTRY.
If KEY-SHOULD-EXIST is non-nil, the user-specified key must exist in
`mew-mlm-master-alist'. If KEY-SHOULD-EXIST is nil, the must already
exist in `mew-mlm-master-alist'.
This is a helper function for `mew-mlm-add-entry-via-guess-interactively'
and `mew-mlm-edit-entry-interactively'."
(let ((key (mew-mlm-entry:key entry))
(help (mew-mlm-entry:help entry))
(unsubscribe (mew-mlm-entry:unsubscribe entry))
(subscribe (mew-mlm-entry:subscribe entry))
(post (mew-mlm-entry:post entry))
(owner (mew-mlm-entry:owner entry))
(archive (mew-mlm-entry:archive entry))
(filter-info (mew-mlm-entry:filter-info entry))
(auth-info (mew-mlm-entry:auth-info entry))
(search-list (mew-mlm-entry:search-list entry))
(parents (mew-mlm-entry:parents entry)))
(setq key
(cond (key-should-exist
(mew-mlm-prompt-for-existing-key key))
((not key-should-exist)
(mew-mlm-prompt-for-new-key))
(t
(error "Should not reach this point in code."))))
(setq help
(mew-mlm-prompt-for-list "Help: " help)
unsubscribe
(mew-mlm-prompt-for-list "Unsubscribe: " unsubscribe)
subscribe
(mew-mlm-prompt-for-list "Subscribe: " subscribe)
post
(mew-mlm-prompt-for-list "Post: " post)
owner
(mew-mlm-prompt-for-list "Owner: " owner)
archive
(mew-mlm-prompt-for-list "Archive: " archive)
filter-info
(mew-mlm-prompt-for-filter-info filter-info))
(mew-mlm-make-entry key
help unsubscribe subscribe post owner archive
filter-info auth-info search-list parents)))
(defun mew-mlm-add-entry-via-guess-interactively ()
"Interactively add a new entry to `mew-mlm-master-alist'.
Never call this non-interactively."
(interactive)
; (mew-summary-msg
(let* ((default-entry (mew-mlm-make-entry-from-message))
(key (mew-mlm-entry:key default-entry)))
;; TODO: perhaps offer choice of overwriting or changing key eventually
(if (mew-mlm-key-exists-p key)
(message "Entry with key `%s' already exists." key)
(mew-mlm-add-new-entry
(mew-mlm-copy-and-morph-entry default-entry nil))))
; )
)
(defun mew-mlm-edit-entry-via-guess-interactively ()
"Interactively edit an existing entry identified by guessing the
mailing list associated with the current message.
Never call this non-interactively."
(interactive)
; (mew-summary-msg
(let ((ml-key (mew-mlm-guess-list-from-message)))
(if ml-key
(let* ((entry (mew-mlm-get-entry ml-key))
(new-entry (mew-mlm-copy-and-morph-entry entry t)))
(mew-mlm-replace-entry entry new-entry))
;; TODO: unnecessary
(message "Not editing any entry.")
))
; )
)
(defun mew-mlm-edit-entry-interactively (key)
"Interactively edit an existing entry keyed to KEY in `mew-mlm-master-alist'.
Supports completion on KEY.
Never call this non-interactively."
(interactive
(list
(completing-read "Edit entry with key: " mew-mlm-master-alist nil t)))
(if (not (equal key ""))
(let* ((entry (mew-mlm-get-entry key))
(new-entry (mew-mlm-copy-and-morph-entry entry t)))
(mew-mlm-replace-entry entry new-entry))
(message "Not editing any entry.")))
(defun mew-mlm-delete-entry-interactively (key)
"Interactively delete entry keyed to KEY from `mew-mlm-master-alist'.
Supports completion."
(interactive
(list
(completing-read "Delete entry with key: " mew-mlm-master-alist nil t)))
(if (not (equal key ""))
(mew-mlm-delete-entry key)
(message "Not deleting any entry.")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; functions for manipulating `mew-mlm-guess-alist'
(defun mew-mlm-make-guess-entry (header)
"Constructor for an entry of `mew-mlm-guess-alist'.
HEADER is a message header name (with colon)."
(cons header nil))
(defun mew-mlm-add-value-to-guess-entry (guess-entry value)
"Add VALUE to GUESS-ENTRY.
GUESS-ENTRY is an entry created by `mew-mlm-make-guess-entry'.
VALUE is a cons cell. The car is a message header value. The cdr is
a key for an entry in `mew-mlm-master-alist'."
(setcdr guess-entry
(cons value (cdr guess-entry))))
;; TODO: consider rewriting to drop above two functions...
;; TODO: decide policy regarding whether to allow ml-entries that
;; have no filter-info
(defun mew-mlm-make-guess-alist ()
"Constructor for `mew-mlm-guess-alist'.
Each key is a message header name. Each value is an alist of elements
representing message header values and corresponding key strings for
entries in `mew-mlm-master-alist'. So each element is a cons cell."
(let (alist)
(mapcar
(function
(lambda (ml-entry)
;; TODO: write selectors for filter-info portion of ml-entry?
(let* ((filter-info (mew-mlm-entry:filter-info ml-entry))
(header-name (mew-mlm-filter-info:header-name filter-info))
(header-value (mew-mlm-filter-info:header-value filter-info))
(ml-key (mew-mlm-entry:key ml-entry))
(guess-entry (assoc header-name alist)))
(if (not guess-entry)
;; no guess-entry, so create a new one and add it to
;; alist
(progn
(setq guess-entry (mew-mlm-make-guess-entry header-name))
(setq alist
(cons guess-entry alist))))
;; TODO: check for duplicates before adding?
(mew-mlm-add-value-to-guess-entry
guess-entry
(cons header-value ml-key)))))
mew-mlm-master-alist)
;; less confusing this way
alist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; guessing -- some code in this section could do w/ a serious rewrite
;; based on `mew-summary-refile-body'
;; TODO: carved out `auto' stuff -- put it back in?
(defun mew-mlm-examine-message (function &rest args)
"Examine the current message using FUNCTION.
Returns the return value of FUNCTION, if successeful.
Should only be used in summary mode with cursor on a message row."
(let (msg buf fld ml-key)
(save-excursion
;; save the cursor position anyway
(mew-summary-goto-message)
;; on the message
(setq fld (mew-summary-folder-name))
(setq msg (mew-summary-message-number)));; msg is never nil
;; show message if not displayed
(if (null mew-summary-buffer-disp-msg)
(save-excursion
(mew-set-buffer-tmp)
(setq buf (current-buffer))
(mew-insert-message fld msg mew-cs-autoconv
mew-header-reasonable-size)
(goto-char (point-min))
(if (and (re-search-forward (concat "^$\\|^" mew-subj:) nil t)
(not (looking-at "^$")))
(let ((med (point)))
(forward-line)
(mew-header-goto-next)
(mew-header-decode-region mew-subj: med (point)))))
;; need to make a cache or a message buffer.
(mew-summary-display nil)
;; mew-cache-hit should be first since we want to get
;; information form the top level header.
(setq buf (or (mew-cache-hit fld msg) (mew-buffer-message))))
(save-excursion
(set-buffer buf)
(apply function args))))
(defun mew-mlm-guess-list-from-message-helper (alist)
"Identify mailing list candidates using current message headers and ALIST.
Each key in ALIST is a header name. Each value in ALIST is a cons
cell. The cdr is a key from `mew-mlm-master-alist', and the car is
a substring of a header value that aids in identifying the mailing
list associated with the key.
ALIST is typically `mew-mlm-guess-alist'.
Returns a list of guesses. Each guess is a key for `mew-mlm-master-alist'.
For most cases the returned list is expected to have a single element.
If there are multiple elements, it is likely that there is some
inconsistency/duplication in `mew-mlm-master-alist' or there is
something fishy about the headers of the current message."
(let (name header sublist key val ent ret)
(while alist
(setq name (car (car alist)))
(setq sublist (cdr (car alist)))
(if (stringp name)
(progn
(setq header (mew-header-get-value name))
(if header
(while sublist
(setq key (car (car sublist)))
(setq val (cdr (car sublist)))
;; TODO: possible to simplify?
(if (and (stringp key)
(string-match key header)
(stringp val))
(setq ent val))
(if ent
(progn
(setq ret (cons ent ret))
(setq ent nil)))
(setq sublist (cdr sublist)))))
;; problem in alist structure? name should be a string
(error "Expected a string, but encountered `%S'." name))
(setq alist (cdr alist)))
(mew-uniq-list (nreverse ret))))
(defun mew-mlm-guess-list-from-message ()
"Guess the mailing list the current message is associated with.
Returns a key for `mew-mlm-master-alist' associated with the guessed
mailing list.
This is a helper function for `mew-mlm-guess-list-from-message', and
assumes that preparations have been made for examining the current
message (via `mew-mlm-examine-message')."
(let* ((ml-guess-list (mew-mlm-examine-message
(function mew-mlm-guess-list-from-message-helper)
mew-mlm-guess-alist))
(n-guesses (length ml-guess-list)))
(cond ((= n-guesses 1)
(car ml-guess-list))
((> n-guesses 1)
(mew-mlm-prompt-from-list-with-default
"Mailing list" ml-guess-list (car ml-guess-list)))
;; TODO: should an offer be made to register a new entry in
;; `mew-mlm-master-alist'?
((= n-guesses 0)
(progn
(message "Unable to identify mailing list.")
(sit-for 1)
nil))
(t
(error "Should not reach this point in code.")))))
;; TODO: consider using some of the extraction functions
(defun mew-mlm-extract-list-id-value (list-id)
(if (string-match "<\\([^>]+\\)>" list-id)
(downcase (match-string 1 list-id))
(error "Unable to extract a value for `%s'." list-id)))
;; TODO: consider using some of the extraction functions
(defun mew-mlm-extract-x-mailing-list-value (x-mailing-list)
(if (string-match "<\\([^>]+\\)>" x-mailing-list)
(downcase (match-string 1 x-mailing-list))
(error "Unable to extract a value for `%s'." x-mailing-list)))
(defun mew-mlm-extract-x-ml-name-value (x-ml-name)
;; as-is
(downcase x-ml-name))
(defun mew-mlm-extract-mailing-list-value (mailing-list)
;; unfortunately, kind of messy
(if (string-match "list \\([^@]+@[^; ]+\\)" mailing-list)
(downcase (match-string 1 mailing-list))
(if (string-match "contact \\([^@]+@[^; ]+\\)" mailing-list)
(downcase (match-string 1 mailing-list))
(error "Unable to extract a value for `%s'." mailing-list))))
(defun mew-mlm-extract-sender-value (sender)
;; as-is
(downcase (mew-mlm-extract-address-from-string sender)))
(defun mew-mlm-make-entry-from-message-helper ()
"Extract header info from current message and construct an entry.
This is a helper function for `mew-mlm-make-entry-from-message',
and assumes that preparations have been made for examining the current
message (via `mew-mlm-examine-message')."
(let ((help
(mew-mlm-string-to-list
(or (mew-header-get-value "List-Help:") "")))
(unsubscribe
(mew-mlm-string-to-list
(or (mew-header-get-value "List-Unsubscribe:") "")))
(subscribe
(mew-mlm-string-to-list
(or (mew-header-get-value "List-Subscribe:") "")))
(post
(mew-mlm-string-to-list
(or (mew-header-get-value "List-Post:") "")))
(owner
(mew-mlm-string-to-list
(or (mew-header-get-value "List-Owner:") "")))
(archive
(mew-mlm-string-to-list
(or (mew-header-get-value "List-Archive:") "")))
(list-id
(mew-header-get-value "List-Id:"))
(x-mailing-list
(mew-header-get-value "X-Mailing-List:"))
(x-ml-name
(mew-header-get-value "X-ML-Name:"))
(mailing-list
(mew-header-get-value "Mailing-List:"))
(sender
(mew-header-get-value "Sender:"))
filter-info key)
;; derive some filter-info
;;
;; base the filter-info decision on the first header name
;; that matches from the following headers (in order):
;;
;; List-Id:
;; X-Mailing-List:
;; X-ML-Name:
;; Mailing-List:
;; Sender:
;;
;; this should cover most cases.
;; NOTE: the following code depends on the fact that
;; mew-header-get-value returns nil for no match
(setq filter-info
(cond (list-id
(mew-mlm-make-filter-info
"List-Id:"
(mew-mlm-extract-list-id-value list-id)))
(x-mailing-list
(mew-mlm-make-filter-info
"X-Mailing-List:"
(mew-mlm-extract-x-mailing-list-value x-mailing-list)))
(x-ml-name
(mew-mlm-make-filter-info
"X-ML-Name:"
(mew-mlm-extract-x-ml-name-value x-ml-name)))
(mailing-list
(mew-mlm-make-filter-info
"Mailing-List:"
(mew-mlm-extract-mailing-list-value mailing-list)))
(sender
(mew-mlm-make-filter-info
"Sender:"
(mew-mlm-extract-sender-value sender)))
(t nil)))
;; TODO: handle this more gracefully
;; check that we got something
(if (not filter-info)
(message "Unable to guess filter information."))
;; guess a value for key
(if list-id
(setq key (mew-mlm-extract-list-id-value list-id))
(let (to)
(setq to (mew-header-get-value "To:"))
(if to
(setq key
(downcase
(mew-mlm-make-list-id-from-address
(mew-mlm-extract-address-from-string to))))
(setq key ""))))
(mew-mlm-make-entry key
help unsubscribe subscribe post owner archive
filter-info "" nil nil)))
(defun mew-mlm-make-entry-from-message ()
"Extract header info from message and construct an entry.
Returns a partially-constructed entry (key is empty string) almost
suitable for addition to `mew-mlm-master-alist'."
(mew-mlm-examine-message
(function mew-mlm-make-entry-from-message-helper)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; refiling
;;
;; by ml returns guess or nil
;;
;; TODO: consider merging portions of this w/
;; `mew-mlm-guess-list-from-message'
(defun mew-refile-guess-by-ml ()
"Guess a refile folder for the current message.
Returns folder name on success, nil for failure."
(let* ((ml-guess-list (mew-mlm-guess-list-from-message-helper
mew-mlm-guess-alist))
(n-guesses (length ml-guess-list))
ml-guess)
(setq ml-guess
(cond ((= n-guesses 1)
(car ml-guess-list))
((> n-guesses 1)
(mew-mlm-prompt-from-list-with-default
"Mailing list" ml-guess-list (car ml-guess-list)))
((= n-guesses 0)
nil)
(t
(error "Should not reach this point in code."))))
(if ml-guess
(mew-mlm-entry:folder (mew-mlm-get-entry ml-guess))
nil)))
(defun mew-mlm-make-refile-guess-alist ()
"Construct a value suitable for `mew-refile-guess-alist' from
`mew-mlm-master-alist'.
Each key is a message header name. Each value is an alist of elements
representing message header values and corresponding folder names for
refiling."
(let (alist)
(mapcar
(function
(lambda (ml-entry)
(let* ((filter-info (mew-mlm-entry:filter-info ml-entry))
(header-name (mew-mlm-filter-info:header-name filter-info))
(header-value (mew-mlm-filter-info:header-value filter-info))
(ml-key (mew-mlm-entry:key ml-entry))
(alist-elt (assoc header-name alist))
new-cons)
(if (not alist-elt)
;; no alist-elt for the header-name yet, so add one
(setq alist-elt (cons header-name nil)
alist (cons alist-elt alist)))
;; TODO: check for duplicates before adding?
;; prepare new-cons (pair of message header value and folder)
(setq new-cons (cons header-value (mew-mlm-entry:folder ml-entry)))
;; add new-cons to alist-elt
(setcdr alist-elt
(cons new-cons (cdr alist-elt))))))
mew-mlm-master-alist)
;; less confusing this way
alist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; list action (e.g. post, unsubscribe, etc.) functions
;; TODO: check for action-name?
(defun mew-mlm-list-action (action-name &optional url-function)
"Perform ACTION-NAME for a list identified by ML-KEY.
Optional argumen is used to massage the url about to be operated on.
It's currently used by `mew-mlm-search-list' to get a query term from the
user and substitute the result into the aforementioned url."
;; TODO: write prompt-for-existing-key function
(let ((ml-key (completing-read
(format "List action `%s' for: " action-name)
mew-mlm-master-alist nil t)))
(if (not (equal ml-key ""))
(let* ((entry (mew-mlm-get-entry ml-key))
(action-field-value (mew-mlm-entry-field entry action-name))
(n-choices (length action-field-value))
choice)
(if (null action-field-value)
(message "No information available for list action `%s'."
action-name)
(if (listp action-field-value)
;; non-empty list (checked for nil already)
(let (url)
(cond ((> n-choices 1)
(setq choice
(mew-mlm-prompt-from-list-with-default
(format "List action `%s' choice" action-name)
action-field-value
(car action-field-value))))
((= n-choices 1)
(setq choice
(car action-field-value))))
(setq url
(mew-mlm-strip-enclosing-angle-brackets
(mew-mlm-extract-abes-from-string choice)))
(if url-function
(setq url (funcall url-function url)))
;; TODO: non-mailto url possible -- fix
(browse-url url))
;; value in mew-mlm-master-alist corrupted?
(error "Expected a list value, but got `%S'."
action-field-value))))
(message "Canceled action."))))
(defun mew-mlm-help ()
"List action for obtaining help for the mailing list.
Supports completion on ML-KEY."
(interactive)
(mew-mlm-list-action "help"))
(defun mew-mlm-unsubscribe ()
"List action for unsubscribing from a mailing list.
Supports completion on ML-KEY."
(interactive)
(mew-mlm-list-action "unsubscribe"))
(defun mew-mlm-subscribe ()
"List action for subscribing to a mailing list.
Supports completion on ML-KEY."
(interactive)
(mew-mlm-list-action "subscribe"))
(defun mew-mlm-post ()
"List action for posting to a mailing list.
Supports completion on ML-KEY."
(interactive)
(mew-mlm-list-action "post"))
(defun mew-mlm-owner ()
"List action for contacting the owner of a mailing list.
Supports completion on ML-KEY."
(interactive)
(mew-mlm-list-action "owner"))
(defun mew-mlm-archive ()
"List action for accessing archives of the mailing list.
Supports completion on ML-KEY."
(interactive)
(mew-mlm-list-action "archive"))
;; TODO: need to url-escape the search string
(defun mew-mlm-build-search-url (url)
"Query the user for a search string, and use URL to construct a url to
use in a search."
(let (search-string)
(setq search-string
(read-from-minibuffer "Search for: "))
(if (string-match mew-mlm-search-term-place-holder url)
(replace-match search-string t t url)
(error "The place-holder string was not found in the url: `%s'."
url))))
(defun mew-mlm-search-list ()
"List action for searching archives of the mailing list.
Supports completion on ML-KEY."
(interactive)
(mew-mlm-list-action "search-list" (function mew-mlm-build-search-url)))
;; TODO: for multiple pieces of posting info, offer choices by completion?
;; TODO: option for prompting user w/ guess before creating message?
(defun mew-mlm-post-to-this-list ()
"
\"This list\" refers to the list associated with the current message,
if any."
(interactive)
;; TODO: if guessing fails, prompt user w/ list choices?
(let* ((ml-key (mew-mlm-guess-list-from-message))
(post (mew-mlm-entry:post (mew-mlm-get-entry ml-key))))
(if (listp post)
;; TODO: unlikely, but possible that url is not mailto:
(mew-browse-url-mailto
(mew-mlm-strip-enclosing-angle-brackets
(mew-mlm-extract-abes-from-string (car post))))
;; TODO: could try to guess post info from To: or Cc: header...
;; TODO: could also offer to some how learn the correct posting info
(message "No post information available."))))
(defun mew-mlm-unsubscribe-from-this-list ()
""
(interactive)
(let ((ml-key (mew-mlm-guess-list-from-message))
unsubscribe)
(if (not ml-key)
;; TODO: unnecessary because mew-mlm-guess-list-from-message
;; displays a relevant message?
(message "Could not guess list associated with the current message.")
(progn
(setq unsubscribe (mew-mlm-entry:unsubscribe
(mew-mlm-get-entry ml-key)))
(if (listp unsubscribe)
(mew-browse-url-mailto
(mew-mlm-strip-enclosing-angle-brackets
(mew-mlm-extract-abes-from-string (car unsubscribe))))
(message "No unsubscribe information availabe."))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; search mark
;; wrapper around `mew-summary-search-mark'
(defun mew-mlm-search-mark-via-list-choice (&optional arg)
"Pick messages according to a pick pattern which you input then put
the '*' mark onto them. The default pattern is looked up in
`mew-mlm-master-alist' after the user specifies which mailing list's
pattern to use.
If called with '\\[universal-argument]', execute
'mew-summary-pick-with-external'. Otherwise, 'mew-summary-pick-with-imls'
is called."
(interactive "P")
; (mew-summary-only
(let ((ml-key (mew-mlm-prompt-for-existing-key))
mew-pick-default-field)
;; TODO: check whether ml-entry exists? -- consistency check...
(let* ((ml-entry (mew-mlm-get-entry ml-key))
(filter-info (mew-mlm-entry:filter-info ml-entry)))
;; TODO: does this check need to happen elsewhere?
(if filter-info
(let ((name (mew-mlm-filter-info:header-name filter-info))
(value (mew-mlm-filter-info:header-value filter-info)))
(setq mew-pick-default-field
(concat
(substring name 0 (- (length name) 1))
"="
value)))
(progn
(message "No filter-info for the list `%s'." ml-key)
(sit-for 1))))
(mew-summary-search-mark arg))
; )
)
;; wrapper around `mew-summary-search-mark'
(defun mew-mlm-search-mark-via-guess (&optional arg)
"Pick messages according to a pick pattern which you input, then put
the '*' mark onto them. The default pattern is looked up in
`mew-mlm-master-alist' after the mailing list associated with the
current message is guessed.
If called with '\\[universal-argument]', execute
'mew-summary-pick-with-external'. Otherwise, 'mew-summary-pick-with-imls'
is called."
(interactive "P")
; (mew-summary-only
(let ((ml-key (mew-mlm-guess-list-from-message))
mew-pick-default-field)
(if ml-key
;; TODO: check whether ml-entry exists?
(let* ((ml-entry (mew-mlm-get-entry ml-key))
(filter-info (mew-mlm-entry:filter-info ml-entry)))
;; TODO: does this check need to happen elsewhere?
(if filter-info
(let ((name (mew-mlm-filter-info:header-name filter-info))
(value (mew-mlm-filter-info:header-value filter-info)))
(setq mew-pick-default-field
(concat
(substring name 0 (- (length name) 1))
"="
value)))
(progn
(message "No filter-info for the list `%s'." ml-key)
(sit-for 1)))))
(mew-summary-search-mark arg))
; )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; intialization function
(defun mew-mlm-setup ()
"Initialization of mew-mlm."
;; initialize `mew-mlm-master-alist'
(mew-mlm-load-master-alist)
;; build `mew-mlm-guess-alist'
(setq mew-mlm-guess-alist (mew-mlm-make-guess-alist))
;; save when quitting
(add-hook 'mew-quit-hook 'mew-mlm-save-master-alist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; main ;-)
;; keybindings
(if (not mew-summary-mode-map)
(message "Unable to add definitions to `mew-summary-mode-map'.")
;; manipulate mailing list info
(define-key mew-summary-mode-map "\C-cega"
'mew-mlm-add-entry-via-guess-interactively)
(define-key mew-summary-mode-map "\C-cege"
'mew-mlm-edit-entry-via-guess-interactively)
(define-key mew-summary-mode-map "\C-cee"
'mew-mlm-edit-entry-interactively)
(define-key mew-summary-mode-map "\C-ced"
'mew-mlm-delete-entry-interactively)
;; message creation
(define-key mew-summary-mode-map "\C-cmh"
'mew-mlm-help)
(define-key mew-summary-mode-map "\C-cmu"
'mew-mlm-unsubscribe)
(define-key mew-summary-mode-map "\C-cms"
'mew-mlm-subscribe)
(define-key mew-summary-mode-map "\C-cmp"
'mew-mlm-post)
(define-key mew-summary-mode-map "\C-cmo"
'mew-mlm-owner)
(define-key mew-summary-mode-map "\C-cma"
'mew-mlm-archive)
;; search then mark
(define-key mew-summary-mode-map "\C-c?g"
'mew-mlm-search-mark-via-guess)
(define-key mew-summary-mode-map "\C-c?c"
'mew-mlm-search-mark-via-list-choice))
;; menus
(if (not mew-summary-mode-menu-spec)
(message "Unable to add definitions to `mew-summary-mode-menu-spec'.")
(setq mew-summary-mode-menu-spec
(append
mew-summary-mode-menu-spec
'("----"
("MLM"
["Add Entry via Guess"
mew-mlm-add-entry-via-guess-interactively (mew-summary-p)]
["Edit Entry via Guess"
mew-mlm-edit-entry-via-guess-interactively (mew-summary-p)]
["Edit Entry"
mew-mlm-edit-entry-interactively (mew-summary-p)]
["Delete Entry"
mew-mlm-delete-entry-interactively (mew-summary-p)]
"----"
["Help Action"
mew-mlm-help]
["Unsubscribe Action"
mew-mlm-unsubscribe]
["Subscribe Action"
mew-mlm-subscribe]
["Post Action"
mew-mlm-post]
["Owner Action"
mew-mlm-owner]
["Archive Action"
mew-mlm-archive]
"----"
["Search via Guess then Mark"
mew-mlm-search-mark-via-guess (mew-summary-p)]
["Search via Choice then Mark"
mew-mlm-search-mark-via-list-choice (mew-summary-p)])
)))
;; code from mew-gemacs.el -- will this work w/ XEmacs?
(easy-menu-define
mew-summary-mode-menu
mew-summary-mode-map
"Menu used in Summary mode."
mew-summary-mode-menu-spec))
(mew-mlm-setup)
(provide 'mew-mlm)
;; UPGRADE INFO:
;;
;; older versions (<= 0.1s) -> newer versions (0.1t and above)
;;
;; after opening the data file (.mew-mlm-master-alist) in a buffer,
;; i applied the following commands to fix my own data:
;;
;; start-kbd-macro -- C-x (
;; end-kbd-macro -- C-x )
;; call-last-kbd-macro -- C-x e
;;
;; the macro i defined does the following:
;;
;; searches for '"filter-info" ' -- note the trailing space
;; inserts a period and a space '. '
;; searches for a colon ':'
;; deletes the following '" . "'
;; inserts a space ' '
;;
;; repeating this macro for the whole buffer should have the desired effect.
;;
;; if you don't want to define the macro yourself, evaluate the following
;; in the *scratch* buffer:
;;
;; (fset 'convert
;; "\C-sfilter-info\" \C-m. \C-s:\C-m\C-d\C-d\C-d\C-d\C-d ")
;;
;; now switch to the buffer with your data and do:
;;
;; (execute-kbd-macro 'convert)
;;
;; that will convert one entry. to convert multiple entries (say 10),
;; do:
;;
;; (execute-kbd-macro 'convert 10)
;;
;; i tested these instructions and found them to work for me. note
;; that it's possible that they may not work as is for your case depending
;; on the content of your data. i don't think it's that likely though.
Mew-dist メーリングリストの案内