Re: Maybe encrypt message ?

["Peter Münster" <pmlists@free.fr>]

On Thu, Nov 26 2015, Xavier Maillard wrote:

> Thank you. Would you please share the logic of your "pm/role" ?

Here is the relevant code of my gnus.el:

--8<---------------cut here---------------start------------->8---
;;;;;;;;;;;;;;;;;; Variables ;;;;;;;;;;;;;;;;;;
(defvar pm/language "fr"
  "Language of current buffer.")
(make-variable-buffer-local 'pm/language)

(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)

;;;;;;;;;;;;;;;;;; Functions ;;;;;;;;;;;;;;;;;;
(defun pm/alter-message-map ()
  (local-set-key [f6] 'pm/cycle-sigs))

(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.: 02 ...")
    (t "Tel.: +33/0 2...")))

(defun pm/address (prefix)
  (let ((address
         (cl-case (intern pm/role)
           ('private '("street" "town"))
           ('a '("a" "street" "town"))
           ('b '("b" "street" "town"))
           ('c '("c" "street" "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/update-lang ()
  "Check current buffer and update pm/language accordingly."
  (require 'auto-dictionary)
  (setq pm/language (adict--evaluate-buffer-find-lang nil)))

(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))))))

;;;;;;;;;;;;;;;;;; Settings ;;;;;;;;;;;;;;;;;;
(setq
 message-signature                 'pm/make-signature
 message-signature-insert-empty-line    nil
 message-subscribed-address-functions   '(gnus-find-subscribed-addresses)
 pm/lists '((:name            "context.list"
             :list-identifier "\\[NTG-context\\]"
             :address         "ntg-context@ntg.nl")
            (:name            "..."
             :list-identifier "..."
             :address         "...") ... )
 pm/roles '((:id "private"      :address "private-address")
            (:id "list"         :address "pmlists@free.fr")
            (:id "a"            :address "a")
            (:id "b"            :address "b")
            (:id "c"            :address "c"))
 pm/other-addresses  '("x" "y" "z")
 pm/list-address     (pm/role->addr "list")
 user-mail-address   (plist-get (car pm/roles) :address)
 gnus-parameters
 `(("^[^.]*$" (gcc-self . t) (display . [not expire]))
   ,@(cl-loop for item in pm/lists collect
           `(,(pm/str->regexp (plist-get item :name))
             (subscribed . t) (gcc-self . none) (display . default)
             (to-list . ,(plist-get item :address))
             (pm/role "list") (pm/language "en")
             (posting-style (address ,pm/list-address)
                            (eval (setq pm/role "list"
                                        pm/language "en"))
                            (To ,(plist-get item :address)))
             (gnus-list-identifiers ,(plist-get item :list-identifier))))
   ("nntp+.*" (pm/role "list") (pm/language "en")
    (posting-style (address ,pm/list-address)
                   (eval (setq pm/role "list" pm/language "en")))))
 pm/addresses (append (list user-mail-address pm/list-address)
                      (cdr (cl-loop for i in pm/roles collect
                                    (plist-get i :address)))
                      pm/other-addresses)
 message-alternative-emails   (regexp-opt (cdr pm/addresses))
 message-dont-reply-to-names  (regexp-opt pm/addresses))

(add-hook 'gnus-article-mode-hook       'pm/alter-article-map)
(add-hook 'gnus-group-mode-hook         'pm/alter-group-map)
(add-hook 'gnus-message-setup-hook      'pm/message-setup)
(add-hook 'gnus-startup-hook            'pm/startup-addons)
(add-hook 'gnus-summary-mode-hook       'pm/alter-summary-map)
(add-hook 'message-mode-hook            'pm/alter-message-map)
(add-hook 'message-send-hook            'pm/message-send)
--8<---------------cut here---------------end--------------->8---

-- 
           Peter