From f904744aeed9c1baf061f93673898dbab00e26fc Mon Sep 17 00:00:00 2001 From: gobo72 Date: Tue, 28 Aug 2012 00:29:07 +0000 Subject: [PATCH] Ajout mode muttrc pour emacs. --- stage5/misc/emacs/muttrc-mode.el | 1638 ++++++++++++++++++++++++++++++ 1 file changed, 1638 insertions(+) create mode 100644 stage5/misc/emacs/muttrc-mode.el diff --git a/stage5/misc/emacs/muttrc-mode.el b/stage5/misc/emacs/muttrc-mode.el new file mode 100644 index 0000000..b3bdd2c --- /dev/null +++ b/stage5/misc/emacs/muttrc-mode.el @@ -0,0 +1,1638 @@ +;;; muttrc-mode.el --- Major mode to edit muttrc under Emacs + +;;; Copyright (C) 2000, 2001, 2002 Laurent Pelecq +;;; Copyright (C) 2009 Kumar Appaiah +;;; +;;; Authors: Laurent Pelecq +;;; Kumar Appaiah + +;;; This program 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 2, or (at your option) +;;; any later version. +;;; +;;; This program 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 this program; if not, write to the Free Software +;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Supported Emacs: +;;; ================ +;;; This mode has only been tested on Emacs 21.2. If you +;;; encounter problems with older versions or with Xemacs, let me +;;; know. + +;;; Installation: +;;; ============= +;;; Add this lines to your .emacs: +;;; (autoload 'muttrc-mode "muttrc-mode.el" +;;; "Major mode to edit muttrc files" t) +;;; (setq auto-mode-alist +;;; (append '(("muttrc\\'" . muttrc-mode)) +;;; auto-mode-alist)) +;;; Be sure this file is in a directory that appears in the load-path. +;;; +;;; You mail want to use this mode for other files like the mail +;;; aliases file. In that case just add the following lines at the end +;;; of these files: +;;; ### Local Variables: *** +;;; ### mode: muttrc *** +;;; ### End: *** + +;;; Customization: +;;; ============== +;;; Execute: M-x configure-group RET muttrc RET +;;; +;;; By default, help on command/variable is displayed automatically +;;; while executing a command to modify them. Disable this feature if +;;; you have problems with. + +;;; Description: +;;; ============ +;;; This mode first goal is to provide syntax highlighting with +;;; font-lock. The basic fontification appears on strings, comments, +;;; command names and variables. Additional fontification for commands +;;; arguments can be enabled through the customization buffer. +;;; +;;; Main commands are: +;;; C-x c -- muttrc-insert-command +;;; C-x s -- muttrc-set-variable +;;; C-x S -- muttrc-unset-variable +;;; +;;; Type C-h m for all key bindings. + +;;; BUGS: +;;; ===== +;;; - Multiline commands are not properly handled and can lead to +;;; unexpected result. + + + +;;; Code: + +;;; ------------------------------------------------------------ +;;; Requirement +;;; ------------------------------------------------------------ + +(require 'man) + +(defconst muttrc-mode-version "$Revision: 1.2 $") + +;;; ------------------------------------------------------------ +;;; Configurable stuff +;;; ------------------------------------------------------------ + +(defgroup muttrc nil + "Muttrc editing commands for Emacs." + :group 'files + :prefix "muttrc-") + +(defcustom muttrc-manual-path "/usr/share/doc/mutt/manual.txt.gz" + "Path to the Mutt manual." + :type 'string + :group 'muttrc) + +(defcustom muttrc-display-help t + "Display help for each command/variable modification if set." + :type 'boolean + :group 'muttrc) + +(defcustom muttrc-folder-abbrev ?+ + "Character used to refer to the folder directory." + :type '(choice (const :tag "+" ?+) + (const :tag "=" ?=)) + :group 'muttrc) + +(defcustom muttrc-argument-faces-alist + '((alias . bold) + (address . default) + (face . default) + (color . default) + (command . default) + (path . default) + (function . default) + (header . default) + (hook . default) + (key . default) + (map . default) + (mimetype . default) + (object . default) + (regexp . default) + (sequence . default) + (string . default) + (hook-type . default)) + "List of faces for the Muttrc command arguments. Standard faces are +symbols like 'bold, 'underline, ... Muttrc files must be revisited in +order for the modifications to take effect." + :type '(repeat (cons symbol symbol)) + :group 'muttrc) + +;;; ------------------------------------------------------------ +;;; For backward compatibility +;;; ------------------------------------------------------------ + +(or (functionp 'match-string-no-properties) + (defalias 'match-string-no-properties 'match-string)) + +;;; ------------------------------------------------------------ +;;; Mutt variables and commands +;;; ------------------------------------------------------------ + +(defconst muttrc-arg-handler-alist + '((alias muttrc-get-word "Alias") + (boolean muttrc-get-boolean "Enable") + (number muttrc-get-number "Number") + (address muttrc-get-string "Address") + (face muttrc-get-from-list "Face" muttrc-face-alist t) + (color muttrc-get-from-list "Color" muttrc-color-alist) + (command muttrc-get-command "Command") + (statement muttrc-get-statement "Command") + (assignment muttrc-get-assignment "Variable" t) + (variable muttrc-get-assignment "Variable" nil) + (path muttrc-get-path "Path") + (function muttrc-get-from-list "Function" muttrc-mutt-function-alist) + (header muttrc-get-from-list "Header name" muttrc-header-alist) + (hook-type muttrc-get-from-list "Hook" muttrc-hook-alist t) + (key muttrc-get-string "Key") + (map muttrc-get-from-list "Map" muttrc-map-alist t) + (mimetype muttrc-get-from-list "MIME type" muttrc-mimetype-alist) + (object muttrc-get-from-list "Object" muttrc-object-alist) + (regexp muttrc-get-string "Regular expression") + (sequence muttrc-get-string "Sequence") + (string muttrc-get-string "String") + (alias-sort-order muttrc-get-from-list "Sort order" + muttrc-alias-sort-order-alist) + (aux-sort-order muttrc-get-from-list "Sort order" + muttrc-aux-sort-order-alist) + (browser-sort-order muttrc-get-from-list "Sort order" + muttrc-browser-sort-order-alist) + (pgp-sort-order muttrc-get-from-list "Sort order" + muttrc-pgp-sort-order-alist) + (quadoption muttrc-get-from-list "Option" muttrc-quadoption-alist) + (sort-order muttrc-get-from-list "Sort order" + muttrc-sort-order-alist)) + "List of handler for each type of argument. The format is: +\(ARG-TYPE FACE HANDLER PROMPT HANDLER-ARGS\). +The PROMPT can be overwritten by in command description.") + +(defconst muttrc-face-alist + '(("none" . 1) ("bold" . 2) ("underline" . 3) + ("reverse" . 4) ("standout". 5))) + +(defconst muttrc-color-alist + '(("default" . 0) + ("black" . 1) ("blue" . 2) ("cyan" . 3) ("green" . 4) + ("magenta" . 5) ("red" . 6) ("white" . 7) ("yellow" . 8) + ("brightdefault" . 9) + ("brightblack" . 10) ("brightblue" . 11) ("brightcyan" . 12) + ("brightgreen" . 13) ("brightmagenta" . 14) ("brightred" . 15) + ("brightwhite" . 16) ("brightyellow" . 17))) + +(defconst muttrc-object-alist + '(("attachment" . 0) + ("body" . 1) + ("bold" . 2) + ("error" . 3) + ("hdrdefault" . 4) + ("header" . 5) + ("index" . 6) + ("indicator" . 7) + ("markers" . 8) + ("message" . 9) + ("normal" . 10) + ("quoted" . 11) + ("search" . 12) + ("signature" . 13) + ("status" . 14) + ("tilde" . 15) + ("tree" . 16) + ("underline" . 17)) + "Mutt object on which color apply.") + +(defconst muttrc-header-alist + '(("content-transfer-encoding" . 0) + ("content-type" . 1) + ("date" . 2) + ("from" . 3) + ("message-id" . 4) + ("mime-version" . 5) + ("organization" . 6) + ("received" . 7) + ("reply-to" . 8) + ("resent-from" . 9) + ("subject" . 10) + ("to" . 11) + ("x-accept-language" . 12) + ("x-mailer" . 13) + ("x-mimetrack" . 14) + ("x-sender" . 15))) + +(defconst muttrc-hook-alist + '(("folder-hook" . 0) ("send-hook" . 1) ("save-hook" . 2) + ("mbox-hook" . 3) ("fcc-hook" . 4) ("fcc-save-hook" . 5) + ("message-hook" . 5) ("charset-hook" . 6) ("iconv-hook" . 7) + ("account-hook" . 8) ("append-hook" . 9) ("close-hook" . 10) + ("crypt-hook" . 11) ("send2-hook" . 12) ("reply-hook" . 13) + ("open-hook" . 14))) + +(defconst muttrc-map-alist + '(("alias" . 0) ("attach" . 1) ("browser" . 2) ("compose" . 3) + ("editor" . 4) ("generic" . 5) ("index" . 6) ("pager" . 7) + ("pgp" . 8) ("postpone" . 9) ("query" . 10))) + +(defconst muttrc-mimetype-alist + '(("application/andrew-inset" "ez") + ("application/excel" "xls") + ("application/fractals" "fif") + ("application/java-archive" "jar") + ("application/mac-binhex40" "hqx") + ("application/msword" "doc" "dot") + ("application/octet-stream" "exe" "bin") + ("application/oda" "oda") + ("application/pdf" "pdf") + ("application/pdf") + ("application/pgp" "pgp") + ("application/postscript" "ai" "eps" "ps" "PS") + ("application/pre-encrypted" "enc") + ("application/rtf" "rtf") + ("application/vnd.lotus-wordpro" "lwp" "sam") + ("application/vnd.ms-access" "mdb" "mda" "mde") + ("application/vnd.ms-excel" "xls") + ("application/vnd.ms-powerpoint" "ppt" "pot" "ppa" "pps" "pwz") + ("application/vnd.ms-schedule" "scd" "sch" "sc2") + ("application/wordperfect5.1" "wpd" "wp6") + ("application/x-arj-compressed" "arj") + ("application/x-bcpio" "bcpio") + ("application/x-chess-pgn" "pgn") + ("application/x-cpio" "cpio") + ("application/x-csh" "csh") + ("application/x-debian-package" "deb") + ("application/x-dvi" "dvi") + ("application/x-fortezza-ckl" "ckl") + ("application/x-gtar" "gtar") + ("application/x-gunzip" "gz") + ("application/x-hdf" "hdf") + ("application/x-javascript" "js" "mocha") + ("application/x-javascript-config" "jsc") + ("application/x-latex" "latex") + ("application/x-mif" "mif") + ("application/x-msdos-program" "com" "exe" "bat") + ("application/x-netcdf" "cdf" "nc") + ("application/x-ns-proxy-autoconfig" "pac") + ("application/x-ns-proxy-autoconfig") + ("application/x-perl" "pl" "pm") + ("application/x-pkcs7-crl" "crl") + ("application/x-pkcs7-mime" "p7m" "p7c") + ("application/x-pkcs7-signature" "p7s") + ("application/x-rar-compressed" "rar") + ("application/x-sh" "sh") + ("application/x-shar" "shar") + ("application/x-stuffit" "sit") + ("application/x-sv4cpio" "sv4cpio") + ("application/x-sv4crc" "sv4crc") + ("application/x-tar" "tar") + ("application/x-tar-gz" "tgz" "tar.gz") + ("application/x-tcl" "tcl") + ("application/x-tex" "tex") + ("application/x-texinfo" "texi" "texinfo") + ("application/x-troff" "t" "tr" "roff") + ("application/x-troff-man" "man") + ("application/x-troff-me" "me") + ("application/x-troff-ms" "ms") + ("application/x-ustar" "ustar") + ("application/x-wais-source" "src") + ("application/x-zip-compressed" "zip") + ("audio/basic" "au" "snd") + ("audio/basic" "snd") + ("audio/midi" "mid" "midi") + ("audio/ulaw" "au") + ("audio/x-aiff" "aif" "aifc" "aiff") + ("audio/x-aiff" "aif" "aiff" "aifc") + ("audio/x-wav" "wav") + ("image/gif" "gif") + ("image/ief" "ief") + ("image/jpeg" "jpe" "jpeg" "jpg") + ("image/png" "png") + ("image/tiff" "tif" "tiff") + ("image/tiff") + ("image/x-MS-bmp" "bmp") + ("image/x-cmu-raster" "ras") + ("image/x-photo-cd" "pcd") + ("image/x-portable-anymap" "pnm") + ("image/x-portable-bitmap" "pbm") + ("image/x-portable-graymap" "pgm") + ("image/x-portable-pixmap" "ppm") + ("image/x-rgb" "rgb") + ("image/x-xbitmap" "xbm") + ("image/x-xpixmap" "xpm") + ("image/x-xwindowdump" "xwd") + ("text/html" "html" "htm" "shtml") + ("text/plain" "txt" "text") + ("text/richtext" "rtx") + ("text/tab-separated-values" "tsv") + ("text/x-setext" "etx") + ("text/x-vcard" "vcf") + ("text/x-vcard") + ("video/dl" "dl") + ("video/fli" "fli") + ("video/gl" "gl") + ("video/mpeg" "mpeg" "mpg" "mpe" "mpv" "vbs" "mpegv") + ("video/quicktime" "qt" "mov" "moov") + ("video/x-msvideo" "avi") + ("video/x-sgi-movie" "movie") + ("x-world/x-vrml" "vrm" "vrml" "wrl"))) + +(defconst muttrc-command-alist + '( + ("folder-hook" ((string) (statement)) nil nil) + ("alias" ((alias) (address)) t nil) + ("unalias" ((alias) (address)) t nil) + ("alternative_order" ((mimetype)) t nil) + ("auto_view" ((mimetype)) t nil) + ("bind" ((map) (key) (function)) nil t) + ("color" ((object) + (color "Foreground") + (color "Background") + (regexp)) nil t) + ("charset-hook" ((string "Alias") + (string "Charset")) nil nil) + ("fcc-hook" ((regexp) (path)) nil nil) + ("fcc-save-hook" ((regexp) (path)) nil nil) + ("folder-hook" ((regexp) (statement)) nil nil) + ("ignore" ((header)) t nil) + ("iconv-hook" ((string "Charset") + (string "Local charset")) nil nil) + ("unignore" ((header)) t nil) + ("hdr_order" ((header)) t nil) + ("unhdr_order" ((header)) t nil) + ("lists" ((address)) t nil) + ("unlists" ((address)) t nil) + ("macro" ((map) (key) (sequence) + (string "Description")) nil t) + ("mailboxes" ((path)) t nil) + ("mono" ((object) (face) (regexp)) nil t) + ("mbox-hook" ((regexp) (path)) nil nil) + ("message-hook" ((regexp) (statement)) nil nil) + ("my_hdr" ((string "Header")) nil nil) + ("unmy_hdr" ((header)) t nil) + ("push" ((string)) nil nil) + ("pgp-hook" ((regexp) + (string "Keyid")) nil nil) + ("save-hook" ((regexp) (path)) nil nil) + ("score" ((regexp) + (number "Value")) nil nil) + ("unscore" ((regexp)) t nil) + ("send-hook" ((regexp) (statement)) nil nil) + ("source" ((path)) nil nil) + ("subscribe" ((address)) t nil) + ("unsubscribe" ((address)) t nil) + ("unhook" ((hook-type)) nil nil) + ("alternates" ((regexp)) nil nil) + ("unalternates" ((regexp)) nil nil)) + "List of muttrc commands with their arguments. Format is: +COMMAND '\(ARG1 ARG2 ...\) REPEAT OPTIONAL +REPEAT and OPTIONAL apply to the last argument. +ARGn is the list of arguments for muttrc-call-arg-handler. Each args +is a list \(ARGTYPE \[ARGNAME\]\).") + +(defconst muttrc-statement-alist + (append + '(("set" ((assignment)) t nil) + ("unset" ((variable)) t nil)) + muttrc-command-alist) + "Additional muttrc commands with their arguments that are handled +differently. See muttrc-command-alist") + + +(defconst muttrc-variables-alist + '(("abort_nosubject" quadoption "ask-yes") + ("abort_unmodified" quadoption "yes") + ("alias_file" path "~/.muttrc") + ("alias_format" string "%4n %2f %t %-10a %r") + ("allow_8bit" boolean t) + ("allow_ansi" boolean nil) + ("arrow_cursor" boolean nil) + ("ascii_chars" boolean nil) + ("askbcc" boolean nil) + ("askcc" boolean nil) + ("assumed_charset" string "us-ascii") + ("attach_format" string "%u%D%I %t%4n %T%.40d%> [%.7m/%.10M, %.6e%?C?, %C?, %s] ") + ("attach_sep" string "\\n") + ("attach_split" boolean t) + ("attribution" string "On %d, %n wrote:") + ("autoedit" boolean nil) + ("auto_tag" boolean nil) + ("beep" boolean t) + ("beep_new" boolean nil) + ("bounce" quadoption "ask-yes") + ("bounce_delivered" boolean t) + ("braille_friendly" boolean nil) + ("charset" string "") + ("check_new" boolean t) + ("collapse_unread" boolean t) + ("uncollapse_jump" boolean nil) + ("compose_format" string "-- Mutt: Compose [Approx. msg size: %l Atts: %a]%>-") + ("config_charset" string "") + ("confirmappend" boolean t) + ("confirmcreate" boolean t) + ("connect_timeout" number 30) + ("content_type" string "text/plain") + ("copy" quadoption "yes") + ("crypt_use_gpgme" boolean nil) + ("crypt_autopgp" boolean t) + ("crypt_autosmime" boolean t) + ("date_format" string "!%a, %b %d, %Y at %I:%M:%S%p %Z") + ("default_hook" string "~f %s !~P | (~P ~C %s)") + ("delete" quadoption "ask-yes") + ("delete_untag" boolean t) + ("digest_collapse" boolean t) + ("display_filter" path "") + ("dotlock_program" path "/usr/bin/mutt_dotlock") + ("dsn_notify" string "") + ("dsn_return" string "") + ("duplicate_threads" boolean t) + ("edit_headers" boolean nil) + ("editor" path "") + ("encode_from" boolean nil) + ("envelope_from_address" e-mail "") + ("escape" string "~") + ("fast_reply" boolean nil) + ("fcc_attach" boolean t) + ("fcc_clear" boolean nil) + ("file_charset" string "") + ("folder" path "~/Mail") + ("folder_format" string "%2C %t %N %F %2l %-8.8u %-8.8g %8s %d %f") + ("followup_to" boolean t) + ("force_name" boolean nil) + ("forward_decode" boolean t) + ("forward_edit" quadoption "yes") + ("forward_format" string "[%a: %s]") + ("forward_quote" boolean nil) + ("from" e-mail "") + ("gecos_mask" regular "^[^,]*") + ("hdrs" boolean t) + ("header" boolean nil) + ("help" boolean t) + ("hidden_host" boolean nil) + ("hide_limited" boolean nil) + ("hide_missing" boolean t) + ("hide_thread_subject" boolean t) + ("hide_top_limited" boolean nil) + ("hide_top_missing" boolean t) + ("history" number 10) + ("honor_followup_to" quadoption "yes") + ("hostname" string "") + ("ignore_list_reply_to" boolean nil) + ("imap_authenticators" string "") + ("imap_check_subscribed" boolean nil) + ("imap_delim_chars" string "/.") + ("imap_headers" string "") + ("imap_home_namespace" string "") + ("imap_idle" boolean nil) + ("imap_keepalive" number 900) + ("imap_list_subscribed" boolean nil) + ("imap_login" string "") + ("imap_pass" string "") + ("imap_passive" boolean t) + ("imap_peek" boolean t) + ("imap_servernoise" boolean t) + ("imap_user" string "") + ("implicit_autoview" boolean nil) + ("include" quadoption "ask-yes") + ("include_onlyfirst" boolean nil) + ("indent_string" string "> ") + ("index_format" string "%4C %Z %{%b %d} %-15.15L (%?l?%4l&%4c?) %s") + ("hdr_format" string "%4C %Z %{%b %d} %-15.15L (%?l?%4l&%4c?) %s") + ("ispell" path "ispell") + ("keep_flagged" boolean nil) + ("locale" string "C") + ("mail_check" number 5) + ("mailcap_path" string "") + ("mailcap_sanitize" boolean t) + ("maildir_mtime" boolean nil) + ("header_cache" path "") + ("maildir_header_cache_verify" boolean t) + ("header_cache_pagesize" string "16384") + ("maildir_trash" boolean nil) + ("mark_old" boolean t) + ("markers" boolean t) + ("mask" regular "!^\.[^.]") + ("mbox" path "~/mbox") + ("mbox_type" folder mbox) + ("metoo" boolean nil) + ("menu_context" number 0) + ("menu_move_off" boolean t) + ("menu_scroll" boolean nil) + ("meta_key" boolean nil) + ("mh_purge" boolean nil) + ("mh_seq_flagged" string "flagged") + ("mh_seq_replied" string "replied") + ("mh_seq_unseen" string "unseen") + ("mime_forward" quadoption "no") + ("mime_forward_decode" boolean nil) + ("mime_forward_rest" quadoption "yes") + ("pgp_mime_signature_filename" string "signature.asc") + ("pgp_mime_signature_description" string "Digital signature") + ("mix_entry_format" string "%4n %c %-16s %a") + ("mixmaster" path "mixmaster") + ("move" quadoption "ask-no") + ("message_cachedir" path "") + ("message_format" string "%s") + ("narrow_tree" boolean nil) + ("net_inc" number 10) + ("pager" path "builtin") + ("pager_context" number 0) + ("pager_format" string "-%Z- %C/%m: %-20.20n %s") + ("pager_index_lines" number 0) + ("pager_stop" boolean nil) + ("crypt_autosign" boolean nil) + ("crypt_autoencrypt" boolean nil) + ("pgp_ignore_subkeys" boolean t) + ("crypt_replyencrypt" boolean t) + ("crypt_replysign" boolean nil) + ("crypt_replysignencrypted" boolean nil) + ("crypt_timestamp" boolean t) + ("pgp_use_gpg_agent" boolean nil) + ("crypt_verify_sig" quadoption "yes") + ("pgp_verify_sig" quadoption "yes") + ("smime_is_default" boolean nil) + ("smime_ask_cert_label" boolean t) + ("smime_decrypt_use_default_key" boolean t) + ("pgp_entry_format" string "%4n %t%f %4l/0x%k %-4a %2c %u") + ("pgp_good_sign" regular "") + ("pgp_check_exit" boolean t) + ("pgp_long_ids" boolean nil) + ("pgp_retainable_sigs" boolean nil) + ("pgp_autoinline" boolean nil) + ("pgp_replyinline" boolean nil) + ("pgp_show_unusable" boolean t) + ("pgp_sign_as" string "") + ("pgp_strict_enc" boolean t) + ("pgp_timeout" number 300) + ("pgp_sort_keys" sort address) + ("pgp_mime_auto" quadoption "ask-yes") + ("pgp_auto_decode" boolean nil) + ("pgp_decode_command" string "") + ("pgp_getkeys_command" string "") + ("pgp_verify_command" string "") + ("pgp_decrypt_command" string "") + ("pgp_clearsign_command" string "") + ("pgp_sign_command" string "") + ("pgp_encrypt_sign_command" string "") + ("pgp_encrypt_only_command" string "") + ("pgp_import_command" string "") + ("pgp_export_command" string "") + ("pgp_verify_key_command" string "") + ("pgp_list_secring_command" string "") + ("pgp_list_pubring_command" string "") + ("forward_decrypt" boolean t) + ("smime_timeout" number 300) + ("smime_encrypt_with" string "") + ("smime_keys" path "") + ("smime_ca_location" path "") + ("smime_certificates" path "") + ("smime_decrypt_command" string "") + ("smime_verify_command" string "") + ("smime_verify_opaque_command" string "") + ("smime_sign_command" string "") + ("smime_sign_opaque_command" string "") + ("smime_encrypt_command" string "") + ("smime_pk7out_command" string "") + ("smime_get_cert_command" string "") + ("smime_get_signer_cert_command" string "") + ("smime_import_cert_command" string "") + ("smime_get_cert_email_command" string "") + ("smime_default_key" string "") + ("ssl_force_tls" boolean nil) + ("ssl_starttls" quadoption "yes") + ("certificate_file" path "~/.mutt_certificates") + ("ssl_use_sslv3" boolean t) + ("ssl_use_tlsv1" boolean t) + ("ssl_min_dh_prime_bits" number 0) + ("ssl_ca_certificates_file" path "") + ("pipe_split" boolean nil) + ("pipe_decode" boolean nil) + ("pipe_sep" string "\\n") + ("pop_authenticators" string "") + ("pop_auth_try_all" boolean t) + ("pop_checkinterval" number 60) + ("pop_delete" quadoption "ask-no") + ("pop_host" string "") + ("pop_last" boolean nil) + ("pop_reconnect" quadoption "ask-yes") + ("pop_user" string "") + ("pop_pass" string "") + ("post_indent_string" string "") + ("postpone" quadoption "ask-yes") + ("postponed" path "~/postponed") + ("preconnect" string "") + ("print" quadoption "ask-no") + ("print_command" path "lpr") + ("print_decode" boolean t) + ("print_split" boolean nil) + ("prompt_after" boolean t) + ("query_command" path "") + ("quit" quadoption "yes") + ("quote_regexp" regular "^([ \t]*[|>:}#])+") + ("read_inc" number 10) + ("read_only" boolean nil) + ("realname" string "") + ("recall" quadoption "ask-yes") + ("record" path "~/sent") + ("reply_regexp" regular "^(re([\[0-9\]+])*|aw):[ \t]*") + ("reply_self" boolean nil) + ("reply_to" quadoption "ask-yes") + ("resolve" boolean t) + ("reverse_alias" boolean nil) + ("reverse_name" boolean nil) + ("reverse_realname" boolean t) + ("rfc2047_parameters" boolean nil) + ("save_address" boolean nil) + ("save_empty" boolean t) + ("save_name" boolean nil) + ("score" boolean t) + ("score_threshold_delete" number -1) + ("score_threshold_flag" number 9999) + ("score_threshold_read" number -1) + ("send_charset" string "us-ascii:iso-8859-1:utf-8") + ("sendmail" path "/usr/sbin/sendmail -oem -oi") + ("sendmail_wait" number 0) + ("shell" path "") + ("sig_dashes" boolean t) + ("sig_on_top" boolean nil) + ("signature" path "~/.signature") + ("simple_search" string "~f %s | ~s %s") + ("smart_wrap" boolean t) + ("smileys" regular "(>From )|(:[-^]?[][)(><}{|/DP])") + ("sleep_time" number 1) + ("sort" sort date) + ("sort_alias" sort alias) + ("sort_aux" sort date) + ("sort_browser" sort alpha) + ("sort_re" boolean t) + ("spam_separator" string ",") + ("spoolfile" path "") + ("status_chars" string "-*%A") + ("status_format" string "-%r-Mutt: %f [Msgs:%?M?%M/?%m%?n? New:%n?%?o? Old:%o?%?d? Del:%d?%?F? Flag:%F?%?t? Tag:%t?%?p? Post:%p?%?b? Inc:%b?%?l? %l?]---(%s/%S)-%>-(%P)---") + ("status_on_top" boolean nil) + ("strict_mime" boolean t) + ("strict_threads" boolean nil) + ("suspend" boolean t) + ("text_flowed" boolean nil) + ("thread_received" boolean nil) + ("thorough_search" boolean nil) + ("tilde" boolean nil) + ("timeout" number 600) + ("tmpdir" path "") + ("to_chars" string " +TCFL") + ("tunnel" string "") + ("use_8bitmime" boolean nil) + ("use_domain" boolean t) + ("use_envelope_from" boolean nil) + ("use_from" boolean t) + ("use_idn" boolean t) + ("use_ipv6" boolean t) + ("user_agent" boolean t) + ("visual" path "") + ("wait_key" boolean t) + ("weed" boolean t) + ("wrap_search" boolean t) + ("wrapmargin" number 0) + ("write_inc" number 10) + ("write_bcc" boolean t) + ("xterm_icon" string "M%?n?AIL&ail?") + ("xterm_set_titles" boolean nil) + ("xterm_title" string "Mutt with %?m?%m messages&no messages?%?n? [%n NEW]?")) + "List of muttrc variables. Format is: +VARIABLE TYPE DEFAULT" + ) + +(defconst muttrc-mutt-function-alist + '(("attach-file" . 0) + ("attach-key" . 1) + ("attach-message" . 2) + ("backspace" . 3) + ("backward-char" . 4) + ("bol" . 5) + ("bottom-page" . 6) + ("bounce-message" . 7) + ("buffy-cycle" . 8) + ("change-dir" . 9) + ("change-folder" . 10) + ("change-folder-readonly" . 11) + ("check-new" . 12) + ("clear-flag" . 13) + ("complete" . 14) + ("complete-query" . 15) + ("copy-file" . 16) + ("copy-message" . 17) + ("create-alias" . 18) + ("current-bottom" . 19) + ("current-middle" . 20) + ("current-top" . 21) + ("decode-copy" . 22) + ("decode-save" . 23) + ("delete-char" . 24) + ("delete-entry" . 25) + ("delete-message" . 26) + ("delete-pattern" . 27) + ("delete-subthread" . 28) + ("delete-thread" . 29) + ("detach-file" . 30) + ("display-address" . 31) + ("display-message" . 32) + ("display-toggle-weed" . 33) + ("edit" . 34) + ("edit-bcc" . 35) + ("edit-cc" . 36) + ("edit-description" . 37) + ("edit-encoding" . 38) + ("edit-fcc" . 39) + ("edit-file" . 40) + ("edit-from" . 41) + ("edit-headers" . 42) + ("edit-message" . 43) + ("edit-mime" . 44) + ("edit-reply-to" . 45) + ("edit-subject" . 46) + ("edit-to" . 47) + ("edit-type" . 48) + ("enter-command" . 49) + ("enter-mask" . 50) + ("eol" . 51) + ("exit" . 52) + ("extract-keys" . 53) + ("fetch-mail" . 54) + ("filter-entry" . 55) + ("first-entry" . 56) + ("flag-message" . 57) + ("forget-passphrase" . 58) + ("forward-char" . 59) + ("forward-message" . 60) + ("group-reply" . 61) + ("half-down" . 62) + ("half-up" . 63) + ("help" . 64) + ("history-down" . 65) + ("history-up" . 66) + ("ispell" . 67) + ("jump" . 68) + ("kill-eol" . 69) + ("kill-line" . 70) + ("kill-word" . 71) + ("last-entry" . 72) + ("limit" . 73) + ("list-reply" . 74) + ("mail" . 75) + ("mail-key" . 76) + ("mark-as-new" . 77) + ("middle-page" . 78) + ("new-mime" . 79) + ("next-entry" . 80) + ("next-line" . 81) + ("next-new" . 82) + ("next-page" . 83) + ("next-subthread" . 84) + ("next-thread" . 85) + ("next-undeleted" . 86) + ("next-unread" . 87) + ("parent-message" . 88) + ("pgp-menu" . 89) + ("pipe-entry" . 90) + ("pipe-message" . 91) + ("postpone-message" . 92) + ("previous-entry" . 93) + ("previous-line" . 94) + ("previous-new" . 95) + ("previous-page" . 96) + ("previous-subthread" . 97) + ("previous-thread" . 98) + ("previous-undeleted" . 99) + ("previous-unread" . 100) + ("print-entry" . 101) + ("print-message" . 102) + ("query" . 103) + ("query-append" . 104) + ("quit" . 105) + ("quote-char" . 106) + ("read-subthread" . 107) + ("read-thread" . 108) + ("recall-message" . 109) + ("redraw-screen" . 110) + ("refresh" . 111) + ("rename-file" . 112) + ("reply" . 113) + ("save-entry" . 114) + ("save-message" . 115) + ("search" . 116) + ("search-next" . 117) + ("search-opposite" . 118) + ("search-reverse" . 119) + ("search-toggle" . 120) + ("select-entry" . 121) + ("select-new" . 122) + ("send-message" . 123) + ("set-flag" . 124) + ("shell-escape" . 125) + ("show-limit" . 126) + ("show-version" . 127) + ("skip-quoted" . 128) + ("sort" . 129) + ("sort-mailbox" . 130) + ("sort-reverse" . 131) + ("subscribe" . 132) + ("sync-mailbox" . 133) + ("tag-entry" . 134) + ("tag-message" . 135) + ("tag-pattern" . 136) + ("tag-prefix" . 137) + ("tag-thread" . 138) + ("toggle-mailboxes" . 139) + ("toggle-new" . 140) + ("toggle-quoted" . 141) + ("toggle-subscribed" . 142) + ("toggle-unlink" . 143) + ("toggle-write" . 144) + ("top" . 145) + ("top-page" . 146) + ("undelete-entry" . 147) + ("undelete-message" . 148) + ("undelete-pattern" . 149) + ("undelete-subthread" . 150) + ("undelete-thread" . 151) + ("unsubscribe" . 152) + ("untag-pattern" . 153) + ("verify-key" . 154) + ("view-attach" . 155) + ("view-attachments" . 156) + ("view-file" . 157) + ("view-mailcap" . 158) + ("view-name" . 159) + ("view-text" . 160) + ("write-fcc" . 161)) + "List of Mutt command (not muttrc!)") + +(defconst muttrc-alias-sort-order-alist + '(("address" . 0) ("alias" . 1) ("unsorted" . 2))) + +(defconst muttrc-aux-sort-order-alist + '(("date-sent" . 0) ("reverse-date-sent" . 1) ("last-date-sent" . 2) + ("date-received" . 3) ("reverse-date-received" . 4) + ("last-date-received" . 5) + ("from" . 6) ("reverse-from" . 7) ("last-from" . 8) + ("mailbox-order" . 9) ("reverse-mailbox-order" . 10) + ("last-mailbox-order" . 11) + ("score" . 12) ("reverse-score" . 13) ("last-score" . 14) + ("size" . 15) ("reverse-size" . 16) ("last-size" . 17) + ("subject" . 18) ("reverse-subject" . 19) ("last-subject" . 20) + ("threads" . 21) ("reverse-threads" . 22) ("last-threads" . 23) + ("to" . 24) ("reverse-to" . 25) ("last-to" . 26))) + +(defconst muttrc-browser-sort-order-alist + '(("alpha" . 0) ("date" . 1) ("size" . 2) ("unsorted" . 3))) + +(defconst muttrc-pgp-sort-order-alist + '(("address" . 0) ("date" . 1) ("keyid" . 2) + ("reverse-address" . 3) ("reverse-date" . 4) + ("reverse-keyid" . 5) ("reverse-trust" . 6) + ("trust" . 7))) + +(defconst muttrc-quadoption-alist + '(("yes" .0) ("no" .1) ("ask-yes" .2) ("ask-no" .3))) + +(defconst muttrc-sort-order-alist + '(("date-sent" . 0) ("reverse-date-sent" . 1) + ("date-received" . 2) ("reverse-date-received" . 3) + ("from" . 4) ("reverse-from" . 5) + ("mailbox-order" . 6) ("reverse-mailbox-order" . 7) + ("score" . 8) ("reverse-score" . 9) + ("size" . 10) ("reverse-size" . 11) + ("subject" . 12) ("reverse-subject" . 13) + ("threads" . 14) ("reverse-threads" . 15) + ("to" . 16) ("reverse-to" . 17))) + +;;; ------------------------------------------------------------ +;;; Font-lock definitions +;;; ------------------------------------------------------------ + +(defun muttrc-string-regexp (quote-char) + (let ((c (char-to-string quote-char))) + (format "%s\\([^\n%s]\\|[\\].\\)*%s" c c c))) + +(defvar muttrc-generic-arg-regexp + (concat "\\(" + (muttrc-string-regexp ?\") + "\\|" + "'\\([^']*\\)'" + "\\|" + (muttrc-string-regexp ?\`) + "\\|" + "\\([^\n\t \"'`#;\\]\\|[\\].\\)+" + "\\)")) + +(defvar muttrc-generic-arg-sequence-regexp + (concat "\\(\\s-*" muttrc-generic-arg-regexp "+\\)*")) + +(defvar muttrc-non-command-keyword-regexp + "\\(^\\|;\\)\\s-*\\<\\(set\\|unset\\|toggle\\|reset\\)\\>") + +(defvar muttrc-variable-regexp + (concat "\\<\\(\\(no\\|inv\\)?\\(" + (mapconcat 'car muttrc-variables-alist "\\|") + "\\)\\)\\>")) + +(defvar muttrc-assignement-regexp + (concat muttrc-variable-regexp + "\\s-*\\(=\\s-*" muttrc-generic-arg-regexp "\\)?")) + +(defun muttrc-search-command-forward (command &optional limit) + (let ((cmd-desc (assoc command muttrc-command-alist))) + (if cmd-desc + (let ((cmd-match-data '()) + (cmd-args (cadr cmd-desc)) + (origin (point)) + beg-0 end-0) + (catch 'done + (while (and (not cmd-match-data) + (re-search-forward + (concat "\\(;\\|^\\)\\s-*\\(" command "\\)") + limit t)) + (let ((beg (nth 4 (match-data))) + (end (nth 5 (match-data)))) + (setq beg-0 beg) + (setq cmd-match-data (list beg end))) + (let ((args cmd-args)) + (while args + (let ((arg-type (caar args)) + (arg-re (if (null (cdr args)) + muttrc-generic-arg-sequence-regexp + muttrc-generic-arg-regexp))) + (skip-syntax-forward "-") + (if (looking-at arg-re) + (let ((beg (nth 0 (match-data))) + (end (nth 1 (match-data)))) + (goto-char end) + (setq cmd-match-data (append cmd-match-data + (list beg end))) + (setq end-0 end) + (setq args (cdr args))) + (progn + (setq args nil) + (setq cmd-match-data nil))))) + (when cmd-match-data + (set-match-data (cons beg-0 + (cons end-0 + cmd-match-data))) + (throw 'done t)))) + (goto-char origin) + nil))))) + + +(defun muttrc-font-lock-keywords () + (let ((command-alist muttrc-command-alist) + keywords) + (while command-alist + (let* ((cmd (caar command-alist)) + (args (cadr (car command-alist))) + (regexp (eval ; Simulate a closure + (list + 'lambda '(&optional limit) + (list 'muttrc-search-command-forward cmd 'limit)))) + (hilighters '((1 font-lock-keyword-face))) + (n 2)) + (while args + (let ((arg-type (caar args)) + (last-arg-p (null (cdr args)))) + (setq hilighters + (append hilighters + (let ((face + (or (cdr-safe + (assoc arg-type + muttrc-argument-faces-alist)) + 'default))) + (list (append (list n (list 'quote face)) + (if last-arg-p '(nil t)))))))) + (setq n (1+ n)) + (setq args (cdr args))) + (setq keywords (append keywords (list (cons regexp hilighters)))) + (setq command-alist (cdr command-alist)))) + (append keywords + (list + (list muttrc-non-command-keyword-regexp 2 + font-lock-keyword-face) + (list muttrc-assignement-regexp 1 + font-lock-variable-name-face))) + )) + +;;; ------------------------------------------------------------ +;;; Mode specific customization +;;; ------------------------------------------------------------ + +(defconst muttrc-mode-map nil + "The keymap that is used in Muttrc mode.") +(if (null muttrc-mode-map) + (setq muttrc-mode-map + (let ((map (make-sparse-keymap)) + (help-map (make-sparse-keymap)) + (ctrl-c-map (make-sparse-keymap))) + (define-key map "\C-c" ctrl-c-map) + (define-key ctrl-c-map "c" 'muttrc-insert-command) + (define-key ctrl-c-map "C" 'comment-region) + (define-key ctrl-c-map "s" 'muttrc-set-variable) + (define-key ctrl-c-map "S" 'muttrc-unset-variable) + (define-key ctrl-c-map "f" 'muttrc-find-variable-in-buffer) + (define-key ctrl-c-map "h" help-map) + (define-key help-map "m" 'muttrc-find-manual-file) + (define-key help-map "v" 'muttrc-find-variable-help) + (define-key help-map "c" 'muttrc-find-command-help) + map))) + +(defvar muttrc-mode-syntax-table nil) +(when (null muttrc-mode-syntax-table) + (setq muttrc-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?# "< " muttrc-mode-syntax-table) + (modify-syntax-entry ?\n "> " muttrc-mode-syntax-table) + (modify-syntax-entry ?\' "$ " muttrc-mode-syntax-table) + (modify-syntax-entry ?\' "$ " muttrc-mode-syntax-table) + (modify-syntax-entry ?_ "w " muttrc-mode-syntax-table) + (modify-syntax-entry ?- "w " muttrc-mode-syntax-table) + ) + +;;; ------------------------------------------------------------ +;;; The mode function itself. +;;; ------------------------------------------------------------ + +;;;###autoload +(defun muttrc-mode () + "Major mode for editing Muttrc files. +This function ends by invoking the function(s) `muttrc-mode-hook'. + +\\{muttrc-mode-map} +" + + (interactive) + (kill-all-local-variables) + + ;; Font lock. + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '('muttrc-font-lock-keywords + nil nil nil nil + (font-lock-syntactic-keywords . (("'[^'\n]*'" 0 "\""))))) + + ;; Comment stuff. + (make-local-variable 'comment-start) + (setq comment-start "#") + (make-local-variable 'comment-end) + (setq comment-end "") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "#+[ \t]*") + + ;; become the current major mode + (setq major-mode 'muttrc-mode) + (setq mode-name "Muttrc") + + ;; Activate keymap and syntax table. + (use-local-map muttrc-mode-map) + (set-syntax-table muttrc-mode-syntax-table) + + (run-hooks 'muttrc-mode-hook)) + + + +;;; ------------------------------------------------------------ +;;; Other functions +;;; ------------------------------------------------------------ + +(defun muttrc-perform-nonreg-test () + (interactive) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^# Begin\\s-+\\(.*\\)$" nil t) + (let ((test-name (match-string-no-properties 1)) + (expr "")) + (catch 'loop + (while t + (or (= (forward-line 1) 0) + (throw 'loop t)) + (if (looking-at (format "^# End\\s-+%s\\s-*" + (regexp-quote test-name))) + (throw 'loop t)) + (if (looking-at "^# End\\s-+\\(.*\\)$") + (error "Found end of %s before %s" + (match-string-no-properties 1) test-name)) + (if (looking-at "^[^#]") + (error "End of %s not found" test-name)) + (if (looking-at "^#\\s-*\\(.*\\)$") + (setq expr (concat expr (match-string-no-properties 1)))))) + (if (eval (read expr)) + (message "Passed: %s" test-name) + (error "Failed: %s" test-name)))))) + +(defun muttrc-quote-string (s) + "Add a backslash on quotes and surround by quotes if needed." + (save-match-data + (cond ((or (not s) (equal s "")) "''") + ((string-match "^[^']*\\s-[^']*$" s) (format "'%s'" s)) + ((string-match "\\s-" s) + (concat "\"" + (mapconcat (lambda (c) + (if (eq c ?\") "\\\"" + (char-to-string c))) + s "") + "\"")) + (t s)))) + +(defun muttrc-prompt-string (prompt-base &optional default) + (if default + (format "%s [%s]: " prompt-base default) + (format "%s: " prompt-base))) + +(defun muttrc-token-around-point (alist &optional strip-fun) + (let ((word (and (functionp 'thing-at-point) + (funcall (or strip-fun 'identity) + (funcall 'thing-at-point 'word))))) + (if (and word (assoc word alist)) + word))) + +(defun muttrc-assignement (varname modifier &optional value) + (concat (format "%s%s" (or modifier "") varname) + (if (stringp value) + (format "=%s" + (muttrc-quote-string value)) + ""))) + +(defun muttrc-split-next-set-line () + "Returns the current line splitted into tokens. The result is a list +of tokens like: +\((CMD START END) ((VAR1 MODIFIER1 ASSIGNMENT1 START END) ... REST)). +Last element REST is one string that is the rest of the line." + (if (re-search-forward + "^\\s-*\\(set\\|unset\\|toggle\\|reset\\)\\s-+" nil t) + (let ((line (list (list (match-string-no-properties 1) + (match-beginning 1) + (match-end 1)))) + (limit (save-excursion + (end-of-line) + (point)))) + (catch 'done + (while (< (point) limit) + (or (looking-at + (format "\\<\\(inv\\|no\\)?\\([a-z][a-z_]*\\)\\>")) + (throw 'done t)) + (let ((modifier (match-string-no-properties 1)) + (varname (match-string-no-properties 2)) + (assignment nil)) + (goto-char (match-end 0)) + (skip-syntax-forward "-" limit) + (if (or (looking-at ; Set without quote + "=\\s-*\\([^'\" \t\n#]+\\)") + (looking-at ; Set with double quote (") + "=\\s-*\"\\(\\([^\"\\]\\|\\\\.\\)*\\)\"") + (looking-at ; Set with single quote (') + "=\\s-*'\\([^']*\\)'")) + (let ((type (let ((desc (assoc varname + muttrc-variables-alist))) + (if desc (cadr desc))))) + (if type + (and (eq type 'boolean) + (message "%s: can't assign a boolean" varname)) + (message "%s: unknown Muttrc variable" + varname)) + (setq assignment (match-string-no-properties 1)) + (goto-char (match-end 0)))) + (nconc line (list (list varname modifier + assignment + (match-beginning 0) + (match-end 0)))) + (skip-syntax-forward "-" limit)))) + (skip-syntax-backward "-") + (if (looking-at ".+$") + (nconc line (list (list (match-string-no-properties 0))))) + (end-of-line) + line))) + +(defun muttrc-splice-assignment (line varname) + "Returns a list where assignements for VARNAME are separated from +assignment for other variables." + (let ((l (cdr line)) + (in '()) + (out '())) + (while (and l (consp (car l))) + (let ((arg (car l))) + (if (string= (car arg) varname) + (setq in (append in (list arg))) + (setq out (append out (list arg))))) + (setq l (cdr l))) + (list in out))) + +(defun muttrc-new-value (cmd varname type modifier value default) + (if (eq type 'boolean) + (cond ((string= cmd "set") + (cond ((null modifier) t) + ((string= modifier "no") nil) + ((string= modifier "inv") (not value)))) + ((string= cmd "unset") + (cond ((null modifier) nil) + ((string= modifier "no") t) + ((string= modifier "inv") value))) + ((string= cmd "toggle") (not value)) + ((string= cmd "reset") + (cond ((null modifier) default) + ((string= modifier "no") (not default)) + ((string= modifier "inv") (not default))))) + (cond ((string= cmd "set") value) + ((string= cmd "unset") default) + ((string= cmd "toggle") + (error "%s: can't toggle non boolean" varname)) + ((string= cmd "reset") default)))) + +(defun muttrc-get-value-and-point (varname) + "Fetch the value of VARIABLE from the current buffer. It returns a +cons (VALUE . POINT) where POINT is the beginning of the line defining +VARNAME." + (save-excursion + (let ((var-descriptor (assoc varname muttrc-variables-alist))) + (or var-descriptor + (error "%s: unknown variable." varname)) + (goto-char (point-min)) + (let ((type (nth 0 (cdr var-descriptor))) + (default (nth 1 (cdr var-descriptor))) + (pos nil)) + (let ((value default)) + ;; We search all the definitions in the buffer because some + ;; users may use toggle or set inv... + (catch 'done + (while t + (let ((line (muttrc-split-next-set-line))) + (or line (throw 'done t)) + (let ((cmd (caar line)) + (assignments + (car (muttrc-splice-assignment line varname)))) + (if assignments + (setq pos (save-excursion + (beginning-of-line) + (point)))) + (while assignments + (let ((modifier (nth 1 (car assignments))) + (new-value (nth 2 (car assignments)))) + (setq value + (muttrc-new-value cmd varname type modifier + (or new-value value) + default))) + (setq assignments (cdr assignments))))))) + (cons value pos)))))) + +(defun muttrc-get-value (varname) + "Fetch the value of VARIABLE from the current buffer." + (let ((value (muttrc-get-value-and-point varname))) + (and value (car value)))) + +;;; ------------------------------------------------------------ +;;; Viewing manual +;;; ------------------------------------------------------------ + +(defvar muttrc-manual-buffer-name "*Mutt Manual*") + +(defun muttrc-find-manual-file-no-select () + "Convert overstriking and underlining to the correct fonts in a +file. The buffer does not visit the file." + (interactive) + (or (file-readable-p muttrc-manual-path) + (error "%s: file not found" muttrc-manual-path)) + (let ((buf (get-buffer-create muttrc-manual-buffer-name))) + (save-excursion + (set-buffer buf) + (if (not buffer-read-only) + (let ((insert-contents-fun + (condition-case nil + (and (require 'jka-compr) + 'jka-compr-insert-file-contents) + (error 'insert-file-contents)))) + (funcall insert-contents-fun muttrc-manual-path nil nil nil t) + (buffer-disable-undo buf) + (Man-fontify-manpage) + (set-buffer-modified-p nil) + (toggle-read-only) + (goto-char (point-min)))) + buf))) + +(defun muttrc-find-manual-file () + "Convert overstriking and underlining to the correct fonts in a +file. The buffer does not visit the file." + (interactive) + (switch-to-buffer-other-window + (muttrc-find-manual-file-no-select) t)) + +(defun muttrc-search-command-help-forward (command) + (when (re-search-forward + (format "^[ \t]*Usage:\\s-*\\(\\[un\\]\\)?%s" command) + nil t) + (goto-char (match-beginning 0)) + (forward-line -2) + (point))) + +(defun muttrc-search-variable-help-forward (command) + (when (and (re-search-forward + (format "^[ \t]*%s\\.?\\s-*%s\\s-*$" + "\\([1-9][0-9.]*\\)" + (regexp-quote variable)) + nil t) + (re-search-forward + (format "^[ \t]*%s\\.?\\s-*%s\\s-*$" + "\\([1-9][0-9.]*\\)" + (regexp-quote variable)) + nil t) + (re-search-forward + (format "^[ \t]*%s\\.?\\s-*%s\\s-*$" + (regexp-quote (match-string-no-properties 1)) + (regexp-quote variable)) + nil t)) + (goto-char (match-beginning 0)) + (point))) + +(defun muttrc-find-help (search-fun topic) + "Find an help topic in the manual and display it. Returns the manual +buffer." + (let ((buf (muttrc-find-manual-file-no-select))) + (let ((win (get-buffer-window buf)) + help-start) + (save-excursion + (set-buffer buf) + (goto-char (point-min)) + (or (funcall search-fun topic) + (error "%s: entry not found in Mutt manual." command)) + (setq help-start (point)) + (unless (get-buffer-window buf) + (switch-to-buffer-other-window buf t)) + (set-window-start win help-start))) + buf)) + +(defun muttrc-find-command-help (&optional command) + (interactive + (let ((word (muttrc-token-around-point muttrc-command-alist))) + (list (muttrc-get-from-list "Command" word 'muttrc-command-alist t)))) + (muttrc-find-help 'muttrc-search-command-help-forward + (if (string-match "^un\\(.*\\)$" command) + (match-string-no-properties 1 command) + command))) + +(defun muttrc-find-variable-help (&optional variable) + (interactive + (list + (let ((word (muttrc-token-around-point + muttrc-variables-alist + (function + (lambda (word) + (if (and word + (string-match "^\\(no\\|inv\\)\\(.*\\)$" word)) + (match-string-no-properties 2 word) + word)))))) + (muttrc-get-from-list "Variable" word 'muttrc-variables-alist)))) + (muttrc-find-help 'muttrc-search-variable-help-forward variable)) + +(defun muttrc-bury-manual-buffer () + (let ((buf (get-buffer muttrc-manual-buffer-name))) + (if buf (bury-buffer buf)))) + +;;; ------------------------------------------------------------ +;;; Argument handlers +;;; ------------------------------------------------------------ + +(defun muttrc-call-arg-handler (key default &optional prompt) + "Call the function that properly prompts for an argument type." + (let ((handler-args (assoc key muttrc-arg-handler-alist))) + (or handler-args + (error "%s: unknown argument type." (symbol-name key))) + (let ((cmd (nth 0 (cdr handler-args))) + (default-prompt (nth 1 (cdr handler-args))) + (args (cdr (cddr handler-args)))) + (apply cmd (or prompt default-prompt) default args)))) + +(defun muttrc-get-boolean (prompt &optional default) + "Prompt for a boolean." + (y-or-n-p (format "%s? " prompt))) + +(defun muttrc-get-number (prompt default) + "Prompt for a string and return DEFAULT if the string is empty" + (or (read-from-minibuffer (muttrc-prompt-string prompt default)) + default)) + +(defun muttrc-get-string (prompt default) + "Prompt for a string and return DEFAULT if the string is empty" + (let ((s (read-from-minibuffer (muttrc-prompt-string prompt default)))) + (if (> (length s) 0) s default))) + +(defun muttrc-get-word (prompt default) + "Prompt for a word and return DEFAULT if it is empty" + (let ((s (read-from-minibuffer (muttrc-prompt-string prompt default)))) + (or (string-match "^\\w*$" s) + (error "%s: invalid entry, expecting a word" s)) + (if (> (length s) 0) s default))) + +(defun muttrc-get-from-list (prompt default list &optional require-match) + "Prompt for a string from list and return DEFAULT if the string is empty" + (let ((s (completing-read (muttrc-prompt-string prompt default) + (symbol-value list) + nil require-match))) + (if (> (length s) 0) s default))) + +(defun muttrc-get-path (prompt default) + "Prompt for a path and return DEFAULT if the string is empty. The +muttrc folder prefix is replaced by MUTTRC-FOLDER-ABBREV." + (let* ((folder (muttrc-get-value "folder")) + (path (read-file-name (muttrc-prompt-string prompt default) + folder folder))) + (let ((compacted-path + (if (string-match (format "^%s/?\\(.*\\)$" (regexp-quote folder)) + path) + (format "%s%s" + (char-to-string muttrc-folder-abbrev) + (match-string-no-properties 1 path)) + path))) + (if (not (string= compacted-path + (char-to-string muttrc-folder-abbrev))) + compacted-path + default)))) + +(defun muttrc-get-assignment (&optional prompt default + with-value-p) + (let ((varname (completing-read (muttrc-prompt-string prompt default) + muttrc-variables-alist))) + (if (assoc varname muttrc-variables-alist) + (let* ((type (cadr (assoc varname muttrc-variables-alist))) + (default (car-safe (muttrc-get-value-and-point varname))) + (value (if with-value-p + (muttrc-call-arg-handler type default "Value")))) + (if with-value-p + (muttrc-assignement varname + (and (eq type 'boolean) + (not value) + "no") + value) + varname)) + default))) + +;;; ------------------------------------------------------------ +;;; Commands insertion +;;; ------------------------------------------------------------ + +(defun muttrc-get-command (&optional prompt default) + "Prompts the usr for a command to enter and asks for all the arguments." + (let* ((cmd (muttrc-get-from-list "Command" nil 'muttrc-command-alist t)) + (cmd-descriptor (cdr (assoc cmd muttrc-command-alist))) + (arg-list-type (nth 0 cmd-descriptor)) + (repeat-p (nth 1 cmd-descriptor)) + (optional-p (nth 2 cmd-descriptor)) + (arg-list-value (list cmd))) + (save-window-excursion + (if (and muttrc-display-help) + (save-excursion + (muttrc-find-command-help cmd))) + (while arg-list-type + (let* ((arg-type (caar arg-list-type)) + (arg (apply 'muttrc-call-arg-handler + (append (list arg-type nil) + (cdar arg-list-type))))) + (if arg + (progn + (nconc arg-list-value + (list (if (eq arg-type 'assignment) + arg ; assignment are quoted by handler + (muttrc-quote-string arg)))) + (if (and repeat-p + (null (cdr arg-list-type))) + (setq optional-p t) + (setq arg-list-type (cdr arg-list-type)))) + (if (and (null (cdr arg-list-type)) + optional-p) + (setq arg-list-type nil) + (error "Argument required")))))) + (muttrc-bury-manual-buffer) + (mapconcat 'identity arg-list-value " "))) + +(defun muttrc-get-statement (&optional prompt default) + (let ((muttrc-command-alist muttrc-statement-alist)) + (muttrc-get-command prompt default))) + +(defun muttrc-insert-command () + "Insert a muttrc command on the current line." + (interactive) + (let ((cmd-line (muttrc-get-command))) + (beginning-of-line) + (or (eolp) (forward-line 1)) + (insert cmd-line) + (newline))) + +;;; ------------------------------------------------------------ +;;; Setting variables +;;; ------------------------------------------------------------ + +(defun muttrc-update-current-line (varname type &optional value) + "Rewrites the current line by setting VARNAME to VALUE. If the +statement is not \"set\", the variable is removed. In set statement, +it is removed if the value is NIL and the variable is not a boolean. +The function returns t is the variable is really assigned in the line." + (let* ((line (muttrc-split-next-set-line)) + (cmd (caar line)) + (kill-whole-line t) + (args "") + (set-p nil)) + (beginning-of-line) + (kill-line) + (let ((l (cdr line))) + (while l + (let ((elt (car l))) + (if (consp elt) + (let ((this-var (nth 0 elt)) + (this-modifier (nth 1 elt)) + (this-value (nth 2 elt))) + (let ((assignement + (if (string= this-var varname) + (when (string= cmd "set") + (setq set-p t) + (cond ((eq type 'boolean) + (muttrc-assignement varname + (if (not value) "no") + value)) + (value + (muttrc-assignement varname nil value)) + (t (setq set-p nil)))) + (muttrc-assignement this-var + this-modifier + this-value)))) + (if assignement + (setq args (concat args " " assignement))))) + (setq args (concat args elt)))) + (setq l (cdr l)))) + (when (not (string= args "")) + (insert cmd) + (insert args) + (newline)) + (backward-char 1) + set-p)) + +(defun muttrc-update-variable (varname type value pos) + (catch 'done + (when pos + (goto-char pos) + (if (muttrc-update-current-line varname type value) + (throw 'done t))) + (end-of-line) + (let ((cr-after-p (bolp)) + (cmd (if (or value (eq type 'boolean)) "set" "unset")) + (modifier (if (and (not value) (eq type 'boolean)) "no"))) + (or cr-after-p (newline)) + (insert cmd " " + (muttrc-assignement varname modifier value)) + (if cr-after-p (newline)))) + t) + +(defun muttrc-set-variable (&optional varname type value pos) + (interactive + (let* ((varname (muttrc-get-from-list "Variable" nil + 'muttrc-variables-alist t)) + (type (cadr (assoc varname muttrc-variables-alist))) + (default (muttrc-get-value-and-point varname))) + (list varname type + (save-window-excursion + (if muttrc-display-help + (save-excursion + (muttrc-find-variable-help varname))) + (muttrc-call-arg-handler type (car default))) + (cdr default)))) + (muttrc-bury-manual-buffer) + (muttrc-update-variable varname type value pos)) + +(defun muttrc-unset-variable (&optional varname type pos) + (interactive + (let* ((varname (muttrc-get-from-list "Variable" nil + 'muttrc-variables-alist t)) + (type (cadr (assoc varname muttrc-variables-alist))) + (default (muttrc-get-value-and-point varname))) + (list varname type (cdr default)))) + (muttrc-update-variable varname type nil pos)) + +(defun muttrc-find-variable-in-buffer (&optional varname) + (interactive + (list (muttrc-get-from-list "Variable" nil + 'muttrc-variables-alist t))) + (let* ((var-info (muttrc-get-value-and-point varname)) + (value (car var-info)) + (pos (cdr-safe var-info))) + (if pos + (goto-char pos) + (progn + (message "%s: variable not set (default: %s)" varname value))))) + +;;; ------------------------------------------------------------ +;;; Almost the end +;;; ------------------------------------------------------------ + +(provide 'muttrc-mode) + +;;; muttrc-mode.el ends here -- 2.20.1