Re: Posting styles, identities... and my stupdity

[Peter Münster]

On Wed, Oct 01 2014, Igor Sosa Mayor wrote:

> And yes: there are some cases in which I want to change the identity on
> the fly.

Perhaps the following code snippets could help (it's about using "roles"
and cycling signatures):

--8<---------------cut here---------------start------------->8---
(defvar pm/role-history nil
  "History list for roles.")

(defvar pm/role         "private")
(make-variable-buffer-local 'pm/role)

(defvar pm/sig-level    0)
(make-variable-buffer-local 'pm/sig-level)

(defun pm/addr->role (address)
  (cl-loop for item in pm/roles
           when (string-equal (plist-get item :address) address)
           return (plist-get item :id)))

(defun pm/role->addr (role)
  (cl-loop for item in pm/roles
           when (string-equal (plist-get item :id) role)
           return (plist-get item :address)))

(defun pm/update-role ()
  "Check current buffer and update pm/role accordingly."
  (let* ((address (mail-strip-quoted-names
                   (message-fetch-field "From")))
         (role (pm/addr->role address)))
    (when role (setq pm/role role))))

(defun pm/phone ()
  (cl-case (intern pm/language)
    ('fr "Tél.: 01 23 45 67 89")
    (t "Tel.: +33/0 123 456 789")))

(defun pm/address (prefix)
  (let ((address
         (cl-case (intern pm/role)
           ('private '("My Street" "12345 My Town"))
           ('company '("My Company" "My Street" "12345 My Town"))
           ('otherrole '("ABC" "My Street" "12345 My Town"))
           ('yetanotherrole '("XYZ" "My Street" "12345 My Town")))))
    (setq address (append address
                          (cl-case (intern pm/language)
                            ('en '("France"))
                            ('de '("Frankreich")))))
    (cl-loop for l in address concat prefix concat l concat "\n")))

(defun pm/make-signature ()
  "Check role, lang and level."
  (cl-case pm/sig-level
    (0 nil)
    (1 "           Peter")
    (2 "           Peter Münster")
    (3 (concat "           Peter Münster\n           " (pm/phone)))
    (4 (concat "           Peter Münster\n"
               (pm/address "           ")
               "           " (pm/phone)))
    (t
     (setq pm/sig-level 0)
     (pm/make-signature))))
    
(defun pm/cycle-sigs ()
  (interactive)
  (save-excursion
    (when (message-goto-signature)
      (forward-line -1)
      (delete-region (1- (point)) (point-max)))
    (incf pm/sig-level)
    (message-insert-signature)))

(defun pm/ask-role ()
  (let ((new-role
         (completing-read
          (format "Role [%s]: " pm/role)
          (mapcar (lambda (x) (plist-get x :id)) pm/roles)
          nil t nil 'pm/role-history pm/role)))
    (when (not (string-equal pm/role new-role))
      (setq pm/role new-role)
      (message-replace-header
       "From"
       (message-make-from nil (pm/role->addr pm/role))))))

(defun pm/message-setup ()
  (cond (gnus-article-reply
         (pm/update-role)
         (pm/update-lang)
         (incf pm/sig-level)
         (save-excursion
           (message-insert-signature)))
        ((save-excursion (message-goto-signature))
         (pm/update-role)
         (pm/update-lang))
        (t
         (pm/ask-role)
         (let ((message-signature-insert-empty-line t))
           (incf pm/sig-level)
           (save-excursion
             (message-insert-signature))))))
--8<---------------cut here---------------end--------------->8---

HTH,
-- 
           Peter