From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/53684 Path: main.gmane.org!not-for-mail From: sigurd@12move.de (Karl =?iso-8859-1?q?Pfl=E4sterer?=) Newsgroups: gmane.emacs.gnus.general Subject: Posting styles and negation of rules; proposal of new syntax Date: Mon, 11 Aug 2003 16:09:55 +0200 Organization: Lemis World Sender: ding-owner@lists.math.uh.edu Message-ID: NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1060611369 21880 80.91.224.253 (11 Aug 2003 14:16:09 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Mon, 11 Aug 2003 14:16:09 +0000 (UTC) Original-X-From: ding-owner+M2228@lists.math.uh.edu Mon Aug 11 16:16:07 2003 Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 19mDSw-0005Vk-00 for ; Mon, 11 Aug 2003 16:16:07 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by malifon.math.uh.edu with smtp (Exim 3.20 #1) id 19mDSp-0000HV-00; Mon, 11 Aug 2003 09:15:59 -0500 Original-Received: from sclp3.sclp.com ([64.157.176.121]) by malifon.math.uh.edu with smtp (Exim 3.20 #1) id 19mDSj-0000HQ-00 for ding@lists.math.uh.edu; Mon, 11 Aug 2003 09:15:53 -0500 Original-Received: (qmail 26008 invoked by alias); 11 Aug 2003 14:15:53 -0000 Original-Received: (qmail 26003 invoked from network); 11 Aug 2003 14:15:52 -0000 Original-Received: from quimby.gnus.org (80.91.224.244) by sclp3.sclp.com with SMTP; 11 Aug 2003 14:15:52 -0000 Original-Received: from news by quimby.gnus.org with local (Exim 3.12 #1 (Debian)) id 19mDZy-0005dc-00 for ; Mon, 11 Aug 2003 16:23:22 +0200 Original-To: ding@gnus.org Original-Path: wintendo.pflaesterer.de!not-for-mail Original-Newsgroups: gnus.ding Original-Lines: 405 Original-NNTP-Posting-Host: p62.246.36.175.tisdip.tiscali.de Original-X-Trace: quimby.gnus.org 1060611802 21673 62.246.36.175 (11 Aug 2003 14:23:22 GMT) Original-X-Complaints-To: usenet@quimby.gnus.org Original-NNTP-Posting-Date: 11 Aug 2003 14:23:22 GMT X-Face: #iIcL\6>Qj/G*F@AL9T*v/R$j@7Q`6#FU&Flg6u6aVsLdWf(H$U5>:;&*>oy>jOIWgA%8w* A!V7X`\fEGoQ[@D'@i^*p3FCC6&Rg~JT/H_*MOX;"o~flADb8^ Mail-Copies-To: never User-Agent: Gnus/5.1003 (Gnus v5.10.3) Hamster/2.0.2.2 Cancel-Lock: sha1:Bz+d+9LJo1aoEB3SKZuccWlAeQU= Precedence: bulk Xref: main.gmane.org gmane.emacs.gnus.general:53684 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:53684 --=-=-= 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 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 ' 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) `(~ ' 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) `(! ' 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=gnus-msg.el.patch Content-Description: gnus-msg.el.patch 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. --=-=-= KP -- "Programs must be written for people to read, and only incidentally for machines to execute." -- Abelson & Sussman, SICP (preface to the first edition) --=-=-=--