Gnus development mailing list
 help / color / mirror / Atom feed
* Posting styles and negation of rules; proposal of new syntax
@ 2003-08-11 14:09 Karl Pflästerer
  2003-08-13 17:06 ` Karl Pflästerer
  2003-10-17 20:01 ` Lars Magne Ingebrigtsen
  0 siblings, 2 replies; 24+ messages in thread
From: Karl Pflästerer @ 2003-08-11 14:09 UTC (permalink / raw)


[-- Attachment #1: Type: text/plain, Size: 3849 bytes --]

Hi,
the subject says nearly all but I will explain it a bit verbosely here
what I mean and why I think it's necessary.


Rational
========

Posting styles are a very powerful tool for Gnus newbies as well as
oldies; sometimes Gnus newbie implies also Emas Lisp newbie so it should
be possible to write most of the rules without any deeper knowledge of
Lisp.  This is *not* true if you want to negate rules which are written
as regular expression to match against the groupname.

You could rewrite that rule as a Lisp form but that's pretty ugly and
clearly no alternative for someone who doesn't grok Lisp.

Solution
========

Therefore I propose an addition to the syntax of posting styles which
allows easy negation.  I will show some possibilities which only differ
in the symbol which is used to indicate negation.

Here is an example for a posting style how it's written at the moment:

(setq posting-styles
	'((".*"
	   (signature "Peace and happiness")
	   (organization "What me?"))
	  ("^comp"
	   (signature "Death to everybody"))
	  ("comp.emacs.i-love-it"
	   (organization "Emacs is it"))))


You needn't know Lisp to be able to write these rules.  But how do you
say `all groups which do *not* start with comp'?  With a regular
expression that's not possible in Emacs Lisp (no lookbehind assertions).

You could write an expression instead of the simple rule but I think an
simpler and IMO much more aesthetic solution exists.

(setq posting-styles
	'((".*"
	   (signature "Peace and happiness")
	   (organization "What me?"))
	  ((not "^comp")
	   (signature "Death to everybody"))
	  ("comp.emacs.i-love-it"
	   (organization "Emacs is it"))))


Here I used `not' to indicate the negation but I will show that other
symbols are also possible and it's merely a matter of style which one to
use.

The negation is achieved with a simple macro.

(defmacro gnus-msg-unlorile (test &rest body)
  "If TEST is t expands to \(unless BODY\) otherwise to \(while BODY\)."
  `(if ,test
    (unless ,@body)
    (when ,@body)))

That macro allows us to write a test and depending on that test the
macro expands to `unless' or `while'.

The test could be like that:

	 (when (and (consp match) (eq (car match) 'not))
	   (setq match (cadr match)))

`match' is in the function `gnus-configure-posting-styles' the element 
which is used to see if a posting style entry should be used.  So we
look here at the car of our rule if it's eq to some symbol (which one is
a matter of taste) we take the cadr of the rule as new match and the
macro expands to

      (unless <match>
         do_something)

So we have a negation of our match.

I think the new syntax is pretty simple and makes posting styles even
more powerfull.

Now to the possibilities for the symbol.  There are some which come to
mind.  I will list them up with some comments of mine.
(a) `(not <match>'
    This is one of the first thoughts one could have if you think about
    negation.  The advantage is it is well known and naturally to write.
    Existing rules (which can also be forms) will not be affected since
    the expansion would be sematically equal.

(b) `(~ <match>'
    This comes also to mind.  The advantage is that from logic
    expressions that symbol may be known to some as sign of complement.
    You hopefully won't look at the whole rule and mistakenly believe it
    to be a `normal' Lisp expression (like with `not').

(c) `(! <match>'
    The same holds true for that symbol.  People who programmed a bit in
    languages like C will know.


The attached patch which is for testing only uses `not'.

I know that at the moment whe have a feature freeze but as it is quite
silent at the moment here I think now we have the time to discuss and
try it out.

If others also think the solution is worth to be added I would write
also something for the manual.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gnus-msg.el.patch --]
[-- Type: text/x-patch, Size: 8192 bytes --]

Index: gnus-msg.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus-msg.el,v
retrieving revision 6.137
diff -u -r6.137 gnus-msg.el
--- gnus-msg.el	9 Jul 2003 16:00:07 -0000	6.137
+++ gnus-msg.el	11 Aug 2003 14:15:45 -0000
@@ -1815,6 +1815,12 @@
 
 ;;; Posting styles.
 
+(defmacro gnus-msg-unlorile (test &rest body)
+  "If TEST is t expands to \(unless BODY\) otherwise to \(while BODY\)."
+  `(if ,test
+    (unless ,@body)
+    (when ,@body)))
+
 (defun gnus-configure-posting-styles (&optional group-name)
   "Configure posting styles according to `gnus-posting-styles'."
   (unless gnus-inhibit-posting-styles
@@ -1833,82 +1839,85 @@
       (dolist (style styles)
 	(setq match (pop style))
 	(goto-char (point-min))
-	(when (cond
-	       ((stringp match)
-		;; Regexp string match on the group name.
-		(string-match match group))
-	       ((eq match 'header)
-		;; Obsolete format of header match.
-		(and (gnus-buffer-live-p gnus-article-copy)
-		     (with-current-buffer gnus-article-copy
-		       (let ((header (message-fetch-field (pop style))))
-			 (and header
-			      (string-match (pop style) header))))))
-	       ((or (symbolp match)
-		    (functionp match))
-		(cond
-		 ((functionp match)
-		  ;; Function to be called.
-		  (funcall match))
-		 ((boundp match)
-		  ;; Variable to be checked.
-		  (symbol-value match))))
-	       ((listp match)
-		(cond
-		 ((eq (car match) 'header)
-		  ;; New format of header match.
-		  (and (gnus-buffer-live-p gnus-article-copy)
-		       (with-current-buffer gnus-article-copy
-			 (let ((header (message-fetch-field (nth 1 match))))
-			   (and header
-				(string-match (nth 2 match) header))))))
-		 (t
-		  ;; This is a form to be evaled.
-		  (eval match)))))
-	  ;; We have a match, so we set the variables.
-	  (dolist (attribute style)
-	    (setq element (pop attribute)
-		  filep nil)
-	    (setq value
-		  (cond
-		   ((eq (car attribute) :file)
-		    (setq filep t)
-		    (cadr attribute))
-		   ((eq (car attribute) :value)
-		    (cadr attribute))
-		   (t
-		    (car attribute))))
-	    ;; We get the value.
-	    (setq v
-		  (cond
-		   ((stringp value)
-		    value)
-		   ((or (symbolp value)
-			(functionp value))
-		    (cond ((functionp value)
-			   (funcall value))
-			  ((boundp value)
-			   (symbol-value value))))
-		   ((listp value)
-		    (eval value))))
-	    ;; Translate obsolescent value.
-	    (cond
+	(gnus-msg-unlorile
+	 (when (and (consp match) (eq (car match) 'not))
+	   (setq match (cadr match)))
+	 (cond
+	   ((stringp match)
+	     ;; Regexp string match on the group name.
+	     (string-match match group))
+	   ((eq match 'header)
+	     ;; Obsolete format of header match.
+	     (and (gnus-buffer-live-p gnus-article-copy)
+		  (with-current-buffer gnus-article-copy
+		    (let ((header (message-fetch-field (pop style))))
+		      (and header
+			   (string-match (pop style) header))))))
+	   ((or (symbolp match)
+		(functionp match))
+	     (cond
+	       ((functionp match)
+		 ;; Function to be called.
+		 (funcall match))
+	       ((boundp match)
+		 ;; Variable to be checked.
+		 (symbol-value match))))
+	   ((listp match)
+	     (cond
+	       ((eq (car match) 'header)
+		 ;; New format of header match.
+		 (and (gnus-buffer-live-p gnus-article-copy)
+		      (with-current-buffer gnus-article-copy
+			(let ((header (message-fetch-field (nth 1 match))))
+			  (and header
+			       (string-match (nth 2 match) header))))))
+	       (t
+		 ;; This is a form to be evaled.
+		 (eval match)))))
+	 ;; We have a match, so we set the variables.
+	 (dolist (attribute style)
+	   (setq element (pop attribute)
+		 filep nil)
+	   (setq value
+		   (cond
+		     ((eq (car attribute) :file)
+		       (setq filep t)
+		       (cadr attribute))
+		     ((eq (car attribute) :value)
+		       (cadr attribute))
+		     (t
+		       (car attribute))))
+	   ;; We get the value.
+	   (setq v
+		   (cond
+		     ((stringp value)
+		       value)
+		     ((or (symbolp value)
+			  (functionp value))
+		       (cond ((functionp value)
+			       (funcall value))
+			     ((boundp value)
+			       (symbol-value value))))
+		     ((listp value)
+		       (eval value))))
+	   ;; Translate obsolescent value.
+	   (cond
 	     ((eq element 'signature-file)
-	      (setq element 'signature
-		    filep t))
+	       (setq element 'signature
+		     filep t))
 	     ((eq element 'x-face-file)
-	      (setq element 'x-face
-		    filep t)))
-	    ;; Get the contents of file elems.
-	    (when (and filep v)
-	      (setq v (with-temp-buffer
-			(insert-file-contents v)
-			(goto-char (point-max))
-			(while (bolp)
-			  (delete-char -1))
-			(buffer-string))))
-	    (setq results (delq (assoc element results) results))
-	    (push (cons element v) results))))
+	       (setq element 'x-face
+		     filep t)))
+	   ;; Get the contents of file elems.
+	   (when (and filep v)
+	     (setq v (with-temp-buffer
+		       (insert-file-contents v)
+		       (goto-char (point-max))
+		       (while (bolp)
+			 (delete-char -1))
+		       (buffer-string))))
+	   (setq results (delq (assoc element results) results))
+	   (push (cons element v) results))))
       ;; Now we have all the styles, so we insert them.
       (setq name (assq 'name results)
 	    address (assq 'address results))
@@ -1919,50 +1928,50 @@
       (dolist (result results)
 	(add-hook 'message-setup-hook
 		  (cond
-		   ((eq 'eval (car result))
-		    'ignore)
-		   ((eq 'body (car result))
-		    `(lambda ()
-		       (save-excursion
-			 (message-goto-body)
-			 (insert ,(cdr result)))))
-		   ((eq 'signature (car result))
-		    (set (make-local-variable 'message-signature) nil)
-		    (set (make-local-variable 'message-signature-file) nil)
-		    (if (not (cdr result))
-			'ignore
+		    ((eq 'eval (car result))
+		      'ignore)
+		    ((eq 'body (car result))
 		      `(lambda ()
-			 (save-excursion
-			   (let ((message-signature ,(cdr result)))
-			     (when message-signature
-			       (message-insert-signature)))))))
-		   (t
-		    (let ((header
-			   (if (symbolp (car result))
-			       (capitalize (symbol-name (car result)))
-			     (car result))))
-		      `(lambda ()
-			 (save-excursion
-			   (message-remove-header ,header)
-			   (let ((value ,(cdr result)))
-			     (when value
-			       (message-goto-eoh)
-			       (insert ,header ": " value)
-			       (unless (bolp)
-				 (insert "\n")))))))))
+			(save-excursion
+			  (message-goto-body)
+			  (insert ,(cdr result)))))
+		    ((eq 'signature (car result))
+		      (set (make-local-variable 'message-signature) nil)
+		      (set (make-local-variable 'message-signature-file) nil)
+		      (if (not (cdr result))
+			'ignore
+			`(lambda ()
+			  (save-excursion
+			    (let ((message-signature ,(cdr result)))
+			      (when message-signature
+				(message-insert-signature)))))))
+		    (t
+		      (let ((header
+			      (if (symbolp (car result))
+				(capitalize (symbol-name (car result)))
+				(car result))))
+			`(lambda ()
+			  (save-excursion
+			    (message-remove-header ,header)
+			    (let ((value ,(cdr result)))
+			      (when value
+				(message-goto-eoh)
+				(insert ,header ": " value)
+				(unless (bolp)
+				  (insert "\n")))))))))
 		  nil 'local))
       (when (or name address)
 	(add-hook 'message-setup-hook
 		  `(lambda ()
-		     (set (make-local-variable 'user-mail-address)
-			  ,(or (cdr address) user-mail-address))
-		     (let ((user-full-name ,(or (cdr name) (user-full-name)))
-			   (user-mail-address
+		    (set (make-local-variable 'user-mail-address)
+		     ,(or (cdr address) user-mail-address))
+		    (let ((user-full-name ,(or (cdr name) (user-full-name)))
+			  (user-mail-address
 			    ,(or (cdr address) user-mail-address)))
-		       (save-excursion
-			 (message-remove-header "From")
-			 (message-goto-eoh)
-			 (insert "From: " (message-make-from) "\n"))))
+		      (save-excursion
+			(message-remove-header "From")
+			(message-goto-eoh)
+			(insert "From: " (message-make-from) "\n"))))
 		  nil 'local)))))
 
 ;;; Allow redefinition of functions.

[-- Attachment #3: Type: text/plain, Size: 181 bytes --]



   KP

-- 
"Programs must be written for people to read, and only incidentally
for machines to execute."
                -- Abelson & Sussman, SICP (preface to the first edition)

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

end of thread, other threads:[~2004-01-07  2:58 UTC | newest]

Thread overview: 24+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2003-08-11 14:09 Posting styles and negation of rules; proposal of new syntax Karl Pflästerer
2003-08-13 17:06 ` Karl Pflästerer
2003-08-13 17:48   ` Reiner Steib
2003-08-13 18:35   ` Simon Josefsson
2003-08-13 20:19     ` Karl Pflästerer
2003-08-13 21:21       ` Simon Josefsson
2003-08-14  6:46       ` Xavier Maillard
2003-08-13 20:28     ` Ted Zlatanov
2003-08-13 20:31     ` lawrence mitchell
2003-08-14  6:45       ` Xavier Maillard
2003-08-15 16:01         ` David S Goldberg
2003-08-15 18:35           ` Xavier Maillard
2003-08-16  0:05             ` Alex Schroeder
2003-08-18 22:27               ` Xavier Maillard
2003-08-18 23:22                 ` Alex Schroeder
2003-08-19 17:33             ` lawrence mitchell
2003-08-14  6:47   ` Xavier Maillard
2003-10-17 20:01 ` Lars Magne Ingebrigtsen
2003-10-19  0:58   ` Karl Pflästerer
2003-10-19 11:22     ` Lars Magne Ingebrigtsen
2004-01-05 13:15     ` Reiner Steib
2004-01-05 22:20       ` Karl Pflästerer
2004-01-06 17:13         ` Karl Pflästerer
2004-01-07  2:58           ` 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).