Gnus development mailing list
 help / color / mirror / Atom feed
* Improvement to message-x.el : Header name completion.
@ 2002-09-25 15:27 Matthieu Moy
  2002-12-29 16:29 ` Lars Magne Ingebrigtsen
  0 siblings, 1 reply; 7+ messages in thread
From: Matthieu Moy @ 2002-09-25 15:27 UTC (permalink / raw)


Hi,

I've got an interesting small piece of code to submit :

Both message-x.el  and message-tab  provide completion in  the headers
content, but none of them provide completion on the header's *name*. 

For example, when I want to  add a followup-to field, I never remember
the shortcut,  (and also  never remember wether  there are one  or two
`l' ;-) so I have to search it in the menu. 

With this, just type "Fo TAB" and you get the field automagically. 

I've done it in message-x.el, which I'm still using because TAB brings
me to the  body when I wish, but the  code should be cut-and-past-able
to message.el.

I've signed the FSF Papers, so you can use this code as you wish. 

-- 
Matthieu


--- message-x.el.orig	Wed Sep 25 17:23:08 2002
+++ emacs-lisp/message-x.el	Wed Sep 25 17:16:56 2002
@@ -3,7 +3,10 @@
 
 ;; $Id: message-x.el,v 1.23 2001/05/30 21:04:47 grossjoh Exp $
 
-;; Author: Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
+;; Author: Kai Grossjohann
+;; <grossjohann@ls6.informatik.uni-dortmund.de>
+;; Modified by Matthieu MOY on September 25th 2002 to add completion
+;; in header names.
 ;; Keywords: news, mail, compose, completion
 
 ;; This file is not part of GNU Emacs.
@@ -217,6 +220,25 @@
                   t)
                  (t nil))))))
 
+(defvar message-x-all-headers '("To" "Cc" "Bcc" "Gcc" "Newsgroups"
+				"From" "Subject" "Mail-Followup-To"
+				"Reply-To" "Followup-To"
+				"Keywords" "Summary" 
+				"Distribution")
+  "List of header names availlable for completion."
+  )
+
+(defvar message-x-all-headers-completion-alist
+  (mapcar 
+   (lambda (x)
+     `(,(concat x ": ")))
+   message-x-all-headers)
+  "Simple transformation of `message-x-all-headers' used for completion.")
+
+(defvar message-x-all-headers-regexp
+  (regexp-opt message-x-all-headers)
+  "Regexp matching the name of a header.")
+
 (defun message-x-tab (&optional skip-completion)
   "Smart completion or indentation in message buffers.
 
@@ -234,30 +256,57 @@
 `message-x-call-completion-function' for details on how to check
 whether the completion function has done something.
 
+Completion also works on headers names. For example, to insert a
+Followup-To field, type \"Fo TAB\" which will be expanded into
+\"Followup-To: \".
+
 A non-nil optional arg SKIP-COMPLETION (prefix arg if invoked
 interactively) means to not attempt completion.  Instead,
 `message-x-unknown-header-function' function is called in all headers,
 known or unknown."
   (interactive "P")
-  (let* ((alist message-x-completion-alist)
-         (which-header (message-x-which-header))
-         header)
-    (run-hook-with-args 'message-x-before-completion-functions which-header)
-    (while (and (not skip-completion)
-                alist
-                (let ((mail-abbrev-mode-regexp (eval (caar alist))))
-                  (not (mail-abbrev-in-expansion-header-p))))
-      (setq alist (cdr alist)))
-    (cond ((and alist (not skip-completion))
-           (let ((p (point))
-                 (func (cdar alist)))
-             (unless (message-x-call-completion-function func)
-               (funcall message-x-unknown-header-function))))
-          ((message-x-in-header-p)
-           (funcall message-x-unknown-header-function))
-          (t
-           (funcall message-x-body-function)))
-    (run-hook-with-args 'message-x-after-completion-functions which-header)))
+  (let* ((begin (point))
+	 (end (save-excursion (beginning-of-line) (point)))
+	 (to-be-completed (buffer-substring-no-properties begin end)))
+    (cond ((string-match "[a-zA-Z]*\: .*" to-be-completed)
+	  (let* ((alist message-x-completion-alist)
+		 (which-header (message-x-which-header))
+		 header)
+	    (run-hook-with-args 'message-x-before-completion-functions which-header)
+	    (while (and (not skip-completion)
+			alist
+			(let ((mail-abbrev-mode-regexp (eval (caar alist))))
+			  (not (mail-abbrev-in-expansion-header-p))))
+	      (setq alist (cdr alist)))
+	    (cond ((and alist (not skip-completion))
+		   (let ((p (point))
+			 (func (cdar alist)))
+		     (unless (message-x-call-completion-function func)
+		       (funcall message-x-unknown-header-function))))
+		  ((message-x-in-header-p)
+		   (funcall message-x-unknown-header-function))
+		  (t
+		   (funcall message-x-body-function)))
+	    (run-hook-with-args 'message-x-after-completion-functions
+				which-header))
+	  )
+	  (t (let ((completion (try-completion to-be-completed message-x-all-headers-completion-alist)))
+	       (cond 
+		((save-excursion (beginning-of-line)
+				 (looking-at (concat "\\("
+						     message-x-all-headers-regexp
+						     "\\): ")))
+		 ;; We are inside a valid header name. Goto it's
+		 ;; value (after the `: ')
+		 (goto-char (match-end 0)))
+		((stringp completion) ; Completion is possible. Do it
+		 (progn
+		   (delete-region begin end)
+		   (insert completion)))
+		(completion (message "Complete field name"))
+		(t (error "no completion")))
+	       ))
+	  )))
 
 (define-key message-mode-map "\t" 'message-x-tab)
 




^ permalink raw reply	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2002-12-29 18:42 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2002-09-25 15:27 Improvement to message-x.el : Header name completion Matthieu Moy
2002-12-29 16:29 ` Lars Magne Ingebrigtsen
2002-12-29 17:10   ` Kai Großjohann
2002-12-29 17:29     ` Lars Magne Ingebrigtsen
2002-12-29 18:12       ` Henrik Enberg
2002-12-29 18:30       ` Kai Großjohann
2002-12-29 18:42         ` Lars Magne Ingebrigtsen

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).