From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/88985 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Helmut Waitzmann Newsgroups: gmane.emacs.gnus.general Subject: Re: How to change from address while in message buffer? Date: Fri, 07 Feb 2020 14:42:32 +0100 Message-ID: <878sleqzrx.fsf@helmutwaitzmann.news.arcor.de> References: <0100016f7a49e83d-b68757b3-72b5-4410-bfd7-5613a32a174b-000000@email.amazonses.com> <0100016f7eba55ec-dd0e8be4-534d-47c5-b676-240b20d39580-000000@email.amazonses.com> Reply-To: Helmut Waitzmann Anti-Spam-Ticket.b.qc3c Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="9523"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux) To: ding@gnus.org Cancel-Lock: sha1:1bQImoGXx16HLZQxfXKjrfIh/yo= Original-X-From: ding-owner+M37188@lists.math.uh.edu Sat Feb 08 16:53:16 2020 Return-path: Envelope-to: ding-account@m.gmane-mx.org Original-Received: from lists1.math.uh.edu ([129.7.128.208]) by ciao.gmane.io with esmtps (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1j0SPz-0002Kp-Tb for ding-account@m.gmane-mx.org; Sat, 08 Feb 2020 16:53:16 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by lists1.math.uh.edu with smtp (Exim 4.92.3) (envelope-from ) id 1j0SPA-0003sa-1g; Sat, 08 Feb 2020 09:52:24 -0600 Original-Received: from mx1.math.uh.edu ([129.7.128.32]) by lists1.math.uh.edu with esmtps (TLSv1.3:TLS_AES_256_GCM_SHA384:256) (Exim 4.92.3) (envelope-from ) id 1j06Hg-0001I0-OJ for ding@lists.math.uh.edu; Fri, 07 Feb 2020 10:15:12 -0600 Original-Received: from quimby.gnus.org ([95.216.78.240]) by mx1.math.uh.edu with esmtps (TLSv1.3:TLS_AES_256_GCM_SHA384:256) (Exim 4.92.3) (envelope-from ) id 1j06He-0008Dg-87 for ding@lists.math.uh.edu; Fri, 07 Feb 2020 10:15:12 -0600 Original-Received: from ciao.gmane.io ([159.69.161.202]) by quimby.gnus.org with esmtps (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1j06HX-0002OA-Os for ding@gnus.org; Fri, 07 Feb 2020 17:15:06 +0100 Original-Received: from list by ciao.gmane.io with local (Exim 4.92) (envelope-from ) id 1j06HW-000Ph5-Nk for ding@gnus.org; Fri, 07 Feb 2020 17:15:02 +0100 X-Injected-Via-Gmane: http://gmane.org/ Mail-Followup-To: ding@gnus.org Mail-Reply-To: Helmut Waitzmann Anti-Spam-Ticket.b.qc3c Mail-Copies-To: nobody List-ID: Precedence: bulk Xref: news.gmane.io gmane.emacs.gnus.general:88985 Archived-At: Pankaj Jangid : >Malcolm Purvis writes: >> If you split your mail from different addresses into different >> groups (say home and work), then you can configure the variable >> gnus-posting-styles to set the default From address for each >> group, as well as signatures, outgoing SMTP server, etc. > >Yes. This works fine. I am using this. So do I. >My only problem is when I am already in *unsent message* buffer >and want to change "From:" header value. > Yes, that was my problem, too.=C2=A0 To get that problem solved, I wrote a set of lisp functions and variables, that, when it comes to send a message, look in the unsent message buffer for to investigate which mail sending service=C2=A0=E2=80=93 may it be SMTP or sendmail=C2=A0=E2=80=93 should be used and what parameters should be set. They send mail via smtpmail or sendmail, depending on the message header: In the message buffer, the "X-My-MSA-Account" header field is looked up, if present, else the "Sender" header field, if present, else the "From" header field.=C2=A0 The e-mail-address in that header field is extracted and used to determine the message submission accounts for looking up the message submission configuration (see variable my-messagesubmission-configuration) by using regular expressions matching on the extracted e-mail address. That configuration is then modified by the contents of the "X-My-MSA-Configuration" header field (if present).=C2=A0 (This allows to even change the configuration ad hoc in the message buffer.)=C2=A0 According to the configuration, smtpmail or sendmail variables are set.=C2=A0 Then the message is sent via the smtpmail or sendmail mailers. To install that library, I put the functions and variables into the file "~/emacslisp/messagesubmission.el" (see below)=C2=A0=E2=80=93 you = are free to choose a different name=C2=A0=E2=80=93, then byte-compiled it. To make use of the library, I 'load' it from my emacs startup file and set the variables 'message-send-mail-function' and 'send-mail-function' to the appropriate functions: ;;;; ;;;; This is to be part of the emacs startup file: ;;;; ;; Load the message submission service file: (load "~/emacslisp/messagesubmission") ;; Note: There is no ".el" file name extension by intention. ;; Have the library hooked in. This will activate it: (setq-default message-send-mail-function (function my-messagesubmission-message-send-mail) send-mail-function (function my-messagesubmission-send-mail)) ;; Configure the message submission variables: (setq-default my-messagesubmission-debug nil) ;; Set it to 't' to have the configuration used when sending a message ;; logged in the "*Messages*" buffer. (setq-default my-messagesubmission-configuration '( ;; If the originator address is someone at home, I'd like to use ;; sendmail: ;; (("@\\(?:[[:graph:]]+\\.\\)?at-home\\.example\\'" t) ;; Use sendmail for sending mail: ;; (send-mail-function sendmail-send-it) (message-send-mail-function message-send-mail-with-sendmail) ;; If sendmail-f is not evil, let the address to be used in the ;; MAIL FROM SMTP command be the address from which the message ;; pretends to originate. ;; Else compute the address by using the userid. ;; (message-sendmail-f-is-evil t)) ;; I've got two mail accounts at the freemail provider ;; "freemail.example". This is the common part of its ;; configuration: ;; (("@freemail\\.example\\'" t) ;; Let gnus speak SMTP to the fremailer's SMTP server: ;; (send-mail-function smtpmail-send-it) (message-send-mail-function message-smtpmail-send-it) ;; This is the SMTP server: ;; (smtpmail-smtp-server "smtp.freemail.example") ;; Use STARTTLS: ;; (smtpmail-smtp-service 587) (clientcertfile nil) (clientkeyfile nil) (mail-specify-envelope-from t)) ;; One of the two accounts at freemail.example: ;; (("\\`Helmut\\.Waitzmann@freemail\\.example\\'" t) (username "Helmut.Waitzmann") (password "secret") (mail-envelope-from "Helmut.Waitzmann@freemail.example")) ;; The other of the two accounts at freemail.example: ;; (("\\`Helmut\\.Waitzmann\\.nospam@freemail\\.example\\'" t) (username "Helmut.Waitzmann.nospam") (password "even more secret") (mail-envelope-from "Helmut.Waitzmann.nospam@freemail.example")) ;; At work, I'll use SMTP to submit a message: ;; (("\\`\\(waitzmann@at-work\\.example\\)\\'" t) (send-mail-function smtpmail-send-it) (message-send-mail-function message-smtpmail-send-it) (smtpmail-smtp-server "smtp.at-work.example") ;; STARTTLS ;; (smtpmail-smtp-service 25) (clientcertfile nil) (clientkeyfile nil) (username "waitzmann") ;; Ask me for the password: ;; (password nil) (mail-specify-envelope-from t) (mail-envelope-from "waitzmann@at-work.example")))) (setq-default smtpmail-debug-info nil) (setq-default smtpmail-debug-verb nil) ;;;; ;;;; This is the file "~/emacslisp/messagesubmission.el": ;;;; (defconst my-messagesubmission-configuration-symbols (let ((configsymbols (make-vector 29 0))) (mapc (function (lambda (cons) (let ((symbol (my-car-strict cons)) (predicate (my-cdr-strict cons)) configsymbol) (unless (and symbol (symbolp symbol)) ;; No non-nil symbol: (signal 'wrong-type-argument (list (lambda (symbol) (and symbol (symbolp symbol))) symbol))) (unless (or (null predicate) (functionp predicate)) (signal 'wrong-type-argument (list (lambda (predicate) (or (null predicate) (functionp predicate))) predicate))) (setq configsymbol (intern (symbol-name symbol) configsymbols)) (set configsymbol predicate)))) (list ;; list of conses of each a configuration symbol and the predicate to= be ;; satisfied. Each list entry is a cons, the car of which is the ;; configuration symbol, and the cdr of which is ;; either nil: Then the configuration symbol shall be unbound. ;; or t: Then the configuration symbol may have a value of any kind. ;; or a predicate: Then the configuration symbol shall have a value ;; that shall satisfy the predicate. (cons 'my-messagesubmission-debug 'booleanp) (cons 'smtpmail-debug-info (lambda (value) t)) (cons 'smtpmail-debug-verb (lambda (value) t)) (cons 'message-send-mail-function (lambda (value) t)) (cons 'send-mail-function (lambda (value) t)) (cons 'message-sendmail-f-is-evil (lambda (value) t)) (cons 'message-sendmail-envelope-from (lambda (value) (or (null value) (eq value 'header)))) (cons 'message-send-mail-partially-limit (lambda (value) (or (null value) (integerp value)))) (cons 'message-interactive (lambda (value) t)) (cons 'smtpmail-mail-address 'stringp) (cons 'smtpmail-smtp-server 'stringp) (cons 'smtpmail-smtp-service (lambda (value) (or (stringp value) (integerp value)))) (cons 'smtpmail-auth-credentials (lambda (value) (or (stringp value) (and (consp value) (stringp (nth 0 value)) (integerp (nth 1 value)) (stringp (nth 2 value)) (let ((v (nth 3 value))) (or (null v) (stringp v))))))) (cons 'smtpmail-starttls-credentials (lambda (value) (and (consp value) (stringp (nth 0 value)) (integerp (nth 1 value)) (let ((v (nth 2 value))) (or (null v) (stringp v))) (let ((v (nth 3 value))) (or (null v) (stringp v)))))) (cons 'username (lambda (value) (or (null value) (stringp value)))) (cons 'password (lambda (value) (or (null value) (stringp value)))) (cons 'clientkeyfile (lambda (value) (or (null value) (stringp value)))) (cons 'clientcertfile (lambda (value) (or (null value) (stringp value)))) (cons 'starttls-use-gnutls 'booleanp) (cons 'starttls-gnutls-program 'stringp) (cons 'starttls-extra-arguments 'listp) (cons 'smtpmail-local-domain (lambda (value) (or (null value) (stringp value)))) (cons 'smtpmail-sendto-domain (lambda (value) (or (null value) (stringp value)))) (cons 'mail-specify-envelope-from 'booleanp) (cons 'mail-envelope-from (lambda (value) t)))) configsymbols) "*obarray containing the symbols, the symbol-names of which denote legal configuration variables which may be set in variable my-messagesubmission-configuration. Each symbol's symbol-value is either nil: Then the configuration symbol shall be unbound. or t: Then the configuration symbol may have a value of any kind. or a predicate: Then the configuration symbol shall have a value that shall satisfy the predicate.") (defvar my-messagesubmission-configuration nil "*List of message submission configurations parts. Each element of this list is a (part of a) message submission configuration. Each message submission configuration part consists of * a regular expression matcher to match the message submission account of the message to be sent: The regular expression matcher is * either a string. Then it is a case sensitive regular expression. * Or it is a list containing 2 elements: * 1st: a string: the regular expression to be matched * 2nd: a boolean: if non-nil, indicating, the matching should ignore case. * zero or more keyword assignments: Each keyword assignment is a list: (keyword value). The keywords, together with their value types are as follows: keyword | valuetype ------------------------------+---------------------------------------- send-mail-function | see variable send-mail-function message-send-mail-function | see variable message-send-mail-function smtpmail-smtp-server | string smtpmail-smtp-service | integer or string, e.g. 587 or \"smtp\" username | string (or nil to be prompted for) password | string (or nil to be prompted for) clientkeyfile | string or nil (see below) clientcertfile | string or nil (see below) Any variable that satisfies the predicate user-variable-p may be specified, too. But be careful not to include user-variables of this package. smtpmail-smtp-server is the server to connect to. Will be used to set the variable smtpmail-smtp-server. Will also be used to set the variables smtpmail-auth-credentials and smtpmail-starttls-credentials. smtpmail-smtp-service is the port to connect to. Will be used to set the variable smtpmail-smtp-service. Will also be used to set the variables smtpmail-auth-credentials and smtpmail-starttls-credentials. username will be used to set the variable smtpmail-auth-credentials. password will be used to set the variable smtpmail-auth-credentials. clientkeyfile is the name of a file (maybe nil, if you do not wish to use client authentication), containing a client key. Will be used to set the variable smtpmail-starttls-credentials. clientcertfile is the name of a file (maybe nil, if you do not wish to use client authentication), containing a client certificate. Will be used to set the variable smtpmail-starttls-credentials. So each element might look like this example: \( (\"\\\\`me@domain\\\\.example\\\\'\" nil) (message-send-mail-function 'message-smtpmail-send-it) (send-mail-function 'smtpmail-send-it) (smtpmail-smtp-server \"mail.domain.example\") (smtpmail-smtp-service 587) (username \"me\") (password nil) (clientkeyfile \"keyfile\") (clientcertfile \"certfile\") )") (defvar my-messagesubmission-debug nil "*If non-nil, prints the configuration via the function 'message'.") (defun my-messagesubmission-send-mail nil "Send mail via variable send-mail-function. This function simply calls \(my-messagesubmission-send-mail-via 'send-mail-function)" (my-messagesubmission-send-mail-via 'send-mail-function)) (defun my-messagesubmission-message-send-mail nil "Send mail via variable message-send-mail-function. This function simply calls \(my-messagesubmission-send-mail-via 'message-send-mail-function)" (my-messagesubmission-send-mail-via 'message-send-mail-function)) (defun my-messagesubmission-send-mail-via (via) "Send mail via smtpmail or sendmail, depending on the message header. In the message buffer, the \"X-My-MSA-Account\" header line is looked up, if present, else the \"Sender\" header line, if present, else the \"From\" header line. The e-mail-address is extracted and used to determine the message submission account for looking up the message submission configuration (see variable my-messagesubmission-configuration). That configuration is modified by the contents of the \"X-My-MSA-Configuration\" header line (if present). According to the configuration, smtpmail or sendmail variables are set. Then the message is sent via the smtpmail or sendmail mailers." (eval-when-compile (require 'smtpmail)) (let* ((account (my-messagesubmission-account)) (assignments (my-messagesubmission-X-My-MSA-Configuration)) (newvars (my-messagesubmission-configuration-variables account (append my-messagesubmission-configuration (list (cons '("" nil) assignments))))) (savedvars (make-vector (length newvars) 0))) ;; Store some symbols, which will be modified later, in newvars to have ;; them saved and restored (in case they aren't already there), too: (let ((symbols '(smtpmail-auth-credentials smtpmail-starttls-credentials message-send-mail-function send-mail-function))) (while symbols (intern (symbol-name (car symbols)) newvars) (setq symbols (cdr symbols)))) ;; Save the current values: (my-utils-copy-symbol-values newvars obarray savedvars) (let (username password clientkeyfile clientcertfile) (let((symbols '(username password clientkeyfile clientcertfile))) (while symbols (makunbound (car symbols)) (setq symbols (cdr symbols)))) (unwind-protect (progn ;; Assign the new values: (my-utils-copy-symbol-values newvars newvars obarray) (when (and (boundp 'smtpmail-smtp-server) (boundp 'smtpmail-smtp-service)) (when (and (boundp 'username) (boundp 'password)) (setq smtpmail-auth-credentials (list (list smtpmail-smtp-server smtpmail-smtp-service username password)))) (when (and (boundp 'clientkeyfile) (boundp 'clientcertfile)) (setq smtpmail-starttls-credentials (list (list smtpmail-smtp-server smtpmail-smtp-service clientkeyfile clientcertfile))))) (when my-messagesubmission-debug (message "\n%S(%S):\nmessagesubmission configuration for account\n%S:\n" 'my-messagesubmission-send-mail-via via account) (mapc (function (lambda (symbol) (let ((var (intern-soft (symbol-name symbol)))) (when var ;; There is a symbol var: (if (boundp var) ;; That symbol has got a symbol-value, i.e. it ;; is a variable: (message " (setq %S '%S)" var (symbol-value var)) ;; That symbol has got no symbol-value: (message " (makunbound '%S)" var)))))) (let (symbols) (mapatoms (function (lambda (symbol) (setq symbols (cons symbol symbols)))) newvars) (sort symbols (function (lambda (s1 s2) (< (compare-strings (symbol-name s1) 0 nil (symbol-name s2) 0 nil) 0))))))) ;; Remove any "X-My-MSA-Account" and "X-My-MSA-Configuration" ;; headers: (let ((deactivate-mark deactivate-mark)) (save-excursion (save-restriction (message-narrow-to-headers) (message-remove-header "^X-My-MSA-\\(?:Account\\|Configuration\\)[ \t]*:" t)))) ;; Send the message: (funcall (symbol-value via))) ;; Restore the saved variables: (my-utils-copy-symbol-values newvars savedvars obarray))))) (defun my-messagesubmission-configuration-variables (account configuration) "The assigned-to symbols from configuration. The return value is an obarray containing the assigned-to symbols. ACCOUNT (a string) is the name of the message submission account, the entries of my-messagesubmission-configuration are matched with." (let ((assignments ;; the (keyword value) pairs in my-messagesubmission-configuration ;; matching the MSA-account (apply (function append) (mapcar (function (lambda (alistentry) (let ((regexpmatcher (car-safe alistentry)) regexp case-fold-search) (if (consp regexpmatcher) ;; then regexpmatcher should be a list consisting of 2 ;; elements: The first element is a string, the regular ;; expression. The second element is a boolean value ;; for case-fold-search: If it is not nil, the regular ;; expression match should ignore case. (progn (setq regexp (car regexpmatcher) regexpmatcher (cdr regexpmatcher)) (unless (consp regexpmatcher) ;; Malformed list: cdr of list is not a cons: Error. (signal 'wrong-type-argument (list 'consp regexpmatcher))) ;; regexpmatcher is a cons. It should be a ;; one-element-list containing the value for ;; case-fold-search: (setq case-fold-search (car regexpmatcher)) ;; There shall be no further elements in the list: (let ((tail (cdr regexpmatcher))) (when tail (error "Surplus (=3Dnon-nil) tail of list: %S" tail)))) ;; else regexpmatcher should be the regular expression its= elf. ;; Then case-fold-search remains nil. (setq regexp regexpmatcher)) (unless (stringp regexp) (signal 'wrong-type-argument (list 'stringp regexp))) (and (string-match-p regexp account) (let ((assignments (cdr-safe alistentry))) (unless (listp assignments) (signal 'wrong-type-argument (list 'listp assignments))) assignments))))) configuration))) (newsymbols (make-vector (length my-messagesubmission-configuration-symbols) 0)= )) (while assignments (let* ((assignment (car assignments)) ;; Each assignment shall be a non-empty list of 1 or 2 ;; elements: ;; 1st element: the symbol. ;; if 2nd element is available: the symbol's value, ;; if 2nd element is not available: the symbol's value is ;; void. ;; Otherwise: Error. (symbol (my-car-strict assignment)) configsymbol) ;; Does the 1st list element denote a non-nil symbol? (unless (and symbol (symbolp symbol)) ;; No non-nil symbol: (signal 'wrong-type-argument (list (lambda (symbol) (and symbol (symbolp symbol))) symbol))) ;; Yes, the 1st list element denotes a non-nil symbol. ;; Is it a known configuration symbol? (let ((symbolname (symbol-name symbol))) (cond ((setq configsymbol (intern-soft symbolname my-messagesubmission-configuration-symbols))) ;; Any user variables are permitted, too: ((user-variable-p symbol) (setq configsymbol (make-symbol symbolname)) (set configsymbol t)) (t ;; This configuration symbol is unknown. (error "%S is not a known configuration variable" symbol)))) ;; Now, look at the rest of the assignment: (setq assignment (cdr assignment)) ;; Depending on (symbol-value configsymbol), assignment either ;; may be an empty list, meaning: no assignment value, i.e. a ;; void variable. Or it may be a one-element list, containing ;; the value. ;; If (eq predicate nil), then there shall be no assignment value: ;; make the symbol unbound. ;; If (eq predicate t), then there may be any optional assignment ;; value. ;; Else there shall be an assignment value that satisfies ;; predicate. (let ((predicate (symbol-value configsymbol)) (newsymbol (intern (symbol-name symbol) newsymbols))) (cond ((null assignment) (unless (or (null predicate) (eq t predicate)) (error "Missing value for the configuration variable %S" newsymbol))) ;; There is not an empty list (meaning: a void symbol). So it ;; should be a list of one element: the value to be assigned. ((not (consp assignment)) ;; Malformed list: It is not a cons: Error. (signal 'wrong-type-argument (list 'consp assignment))) ;; It is a cons. Value =3D (car assignment), whatever that is. ;; Does the list continue after the value? ((cdr assignment) ;; Malformed list: more than one list element (the ;; value). (error "Surplus (=3Dnon-nil) tail of list: %S" (cdr assignment))) (t ;; There is no surplus (=3Dnon-nil) tail of the list. The list ;; consists of one element, which is the value. (let ((value (car assignment))) (unless (or (eq predicate t) (funcall predicate value)) (signal 'wrong-type-argument (list predicate value))) (set newsymbol value)))))) (setq assignments (cdr assignments))) newsymbols)) (defun my-messagesubmission-account nil "Get the MSA account info from \"X-My-MSA-Account\", \"Sender\", and \"Fr= om\". These message headers are examined one after another in this sequence; and the first of them, that exists, is used, to retrieve the message submission account. The account info, e.g. e-mail-address, is extracted by the function mail-extract-address-components." (let ((field (let ((deactivate-mark deactivate-mark)) (save-excursion (save-restriction (message-narrow-to-headers) (or (mail-fetch-field "X-My-MSA-Account" nil t) (mail-fetch-field "Sender" nil t) (mail-fetch-field "From" nil t))))))) (let ((addresses (and field (mail-extract-address-components field t)))) ;; Accept exactly one address only, not less or more: (let ((n (length addresses))) (if (equal n 1) (cadar addresses) (error "There must be specified exactly one message submission account, not %S" n) ))))) (defun my-messagesubmission-X-My-MSA-Configuration nil "Get MSA configuration info from the \"X-My-MSA-Configuration\" header fi= eld. The content of this message header is a list of keyword assignments like those of the variable 'my-messagesubmission-configuration'. For example, there could be the header field X-My-MSA-Configuration: ((smtpmail-smtp-server \"mail-provider.example\") (username \"me\"))" (let ((field (let ((deactivate-mark deactivate-mark)) (save-excursion (save-restriction (message-narrow-to-headers) (mail-fetch-field "X-My-MSA-Configuration" nil nil t)))))) (let ((n (length field))) (cond ((equal n 0) nil) ((equal n 1) (read (car field))) (t (error "In the message header field \"X-My-MSA-Configuration\", there must be specified at most one list of message submission configuration keyword assignments, not %S" n)) )))) (defun my-utils-copy-symbol-values (thevars From To) "For all THEVARS, copy a symbol-value from obarray FROM to obarray TO. For each symbol in the obarray THEVARS, do the following: If there is a variable with the same name in FROM, intern a symbol with the same name into the obarray TO and assign it the symbol-value of the symbol in obarray FROM. If there is no variable with the same name in FROM, then, if there is a symbol with the same name in TO, make its symbol-value unbound. The obarray TO is returned as the function's value." (mapatoms (cond ((eq thevars From) ;; Copy all variables in From, i.e. in the function in the ;; default case, below, there is (eq thevars From) and ;; (eq sourcesymbol symbol). (function (lambda (sourcesymbol) (let ((symbolname (symbol-name sourcesymbol))) (if (boundp sourcesymbol) ;; Copy its value into a variable in the obarray To: (set (intern symbolname To) (symbol-value sourcesymbol)) ;; Else: If a destinationsymbol exists, make its value unbound: (let ((destinationsymbol (intern-soft symbolname To))) (if destinationsymbol (makunbound destinationsymbol)))))))) ((eq thevars To) ;; Assign to all variables in To a value of the corresponding ;; symbol in From. If the symbol in From does not exist ;; or has got no symbol-value, make the symbol in To unbound. (function (lambda (destinationsymbol) (let* ((symbolname (symbol-name destinationsymbol)) (sourcesymbol (intern-soft symbolname From))) (if (and sourcesymbol (boundp sourcesymbol)) ;; sourcesymbol is a variable with the name of ;; destinationsymbol. Copy its value into the variable in ;; the obarray To: (set destinationsymbol (symbol-value sourcesymbol)) ;; Else let the value of the corresponding variable in the ;; obarray To be unbound. (makunbound destinationsymbol)))))) (t (function (lambda (symbol) (let* ((symbolname (symbol-name symbol)) (sourcesymbol (intern-soft symbolname From))) (if (and sourcesymbol (boundp sourcesymbol)) ;; sourcesymbol is a variable with the name of ;; symbol. Copy its value into a variable in the obarray ;; To: (set (intern symbolname To) (symbol-value sourcesymbol)) ;; Else: If a destinationsymbol exists, make its value unbound: (let ((destinationsymbol (intern-soft symbolname To))) (if destinationsymbol (makunbound destinationsymbol))))))))) thevars)) (defun my-car-strict (cons) "signals error, iff cons is not a cons cell, else returns '(car cons)'." (if (consp cons) (car cons) (signal 'wrong-type-argument (list 'consp cons)))) (defun my-cdr-strict (cons) "signals error, iff cons is not a cons cell, else returns '(cdr cons)'." (if (consp cons) (cdr cons) (signal 'wrong-type-argument (list 'consp cons))))