merged.

Pascal J. Bourguignon [2014-03-17 12:55]
merged.
Filename
pjb-color.el
pjb-erc-filter.el
pjb-erc-speak.el
pjb-java-generate.el
pjb-loader.el
pjb-vm.el
diff --git a/pjb-color.el b/pjb-color.el
index 6ea9fe0..ced2899 100644
--- a/pjb-color.el
+++ b/pjb-color.el
@@ -236,9 +236,9 @@ RET   q       hide the buffer, calling `quit' with the current color
     (pjb-color-picker--create-color-picker
      "*test color picker*" "gray33"
      :update (lambda (color)
-               (set-background-color (pjb-color-picker--rgb-color color))
                (message "update %s" color))
      :quit   (lambda (color)
+               (set-background-color (pjb-color-picker--rgb-color color))
                (message "quit   %s" color)
                t)
      :abort  (lambda (color)
diff --git a/pjb-erc-filter.el b/pjb-erc-filter.el
new file mode 100644
index 0000000..78cafea
--- /dev/null
+++ b/pjb-erc-filter.el
@@ -0,0 +1,180 @@
+;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               pjb-erc-filter.el
+;;;;LANGUAGE:           emacs lisp
+;;;;SYSTEM:             POSIX
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Filters irc nicks.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2014-02-24 <PJB> Extracted from ~/rc/emacs-common.el
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2014 - 2014
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+(require 'cl)
+(require 'erc)
+
+(defcustom erc-ignore-per-channel-alist nil
+  "*A-List of regexps matching user identifiers to ignore, for each channel.
+
+Some users are obnoxious only in some channels (eg. rudybot on #emacs).
+
+A user identifier has the form \"nick!login@host\".  If an
+identifier matches, the message from the person will not be
+processed."
+  :group 'erc-ignore
+  :type '(repeat (cons string regexp)))
+
+(defcustom erc-ignore-per-channel-reply-alist nil
+  "*A-List of regexps matching user identifiers to ignore completely, for each channel.
+
+Some users are obnoxious only in some channels (eg. rudybot on #emacs).
+
+
+This differs from `erc-ignore-list' in that it also ignores any
+messages directed at the user.
+
+A user identifier has the form \"nick!login@host\".
+
+If an identifier matches, or a message is addressed to a nick
+whose identifier matches, the message will not be processed.
+
+CAVEAT: ERC doesn't know about the user and host of anyone who
+was already in the channel when you joined, but never said
+anything, so it won't be able to match the user and host of those
+people.  You can update the ERC internal info using /WHO *."
+  :group 'erc-ignore
+  :type '(repeat (cons string regexp)))
+
+;; ;; Note: it would be better to have  per-server-per-channel variables…
+;; (make-variable-buffer-local 'erc-ignore-per-channel-list) ; in server buffers.
+;; (make-variable-buffer-local 'erc-ignore-per-channel-reply-list) ; in server buffers.
+
+
+(defun erc-ignored-user-in-channel-p (msg tgt spec)
+  "Return non-nil if SPEC matches something in `erc-ignore-list'.
+
+Takes a full SPEC of a user in the form \"nick!login@host\", and
+matches against all the regexp's in `erc-ignore-list'.  If any
+match, returns that regexp."
+  (loop
+     for (channel . regexp) in (erc-with-server-buffer erc-ignore-per-channel-alist)
+     thereis (and (string= channel tgt)
+                  (string-match regexp spec))))
+
+
+(defun erc-message-target (msg)
+  "Return the addressed target in MSG.
+
+The addressed target is the string before the first colon in MSG."
+  (if (string-match "^\\([^:, \n]*\\):" msg)
+      (match-string 1 msg)
+    nil))
+
+
+(defun erc-ignored-reply-p (msg tgt proc)
+  ;; FIXME: this docstring needs fixing -- Lawrence 2004-01-08
+  "Return non-nil if MSG matches something in `erc-ignore-reply-list'.
+
+Takes a message MSG to a channel and returns non-nil if the addressed
+user matches any regexp in `erc-ignore-reply-list'."
+  (let ((target-nick (erc-message-target msg)))
+    (if (not target-nick)
+        nil
+        (erc-with-buffer (tgt proc)
+          (let ((user (erc-get-server-user target-nick)))
+            (when user
+              (let ((spec (erc-user-spec user)))
+                (or (erc-list-match erc-ignore-reply-list spec)
+                    (loop
+                       for (channel . regexp) in (erc-with-server-buffer erc-ignore-per-channel-reply-alist)
+                       thereis (and (string= channel tgt)
+                                    (string-match regexp spec)))))))))))
+
+
+(when (require 'erc-backend nil t)
+  (define-erc-response-handler (PRIVMSG NOTICE)
+      "Handle private messages, including messages in channels." nil
+      (let ((sender-spec (erc-response.sender parsed))
+            (cmd (erc-response.command parsed))
+            (tgt (car (erc-response.command-args parsed)))
+            (msg (erc-response.contents parsed)))
+        (if (or (erc-ignored-user-p                    sender-spec)
+                (erc-ignored-user-in-channel-p msg tgt sender-spec)
+                (erc-ignored-reply-p           msg tgt proc))
+            (when erc-minibuffer-ignored
+              (message "Ignored %s from %s to %s for %s %s %s" cmd sender-spec tgt
+                       (erc-ignored-user-p                    sender-spec)
+                       (erc-ignored-user-in-channel-p msg tgt sender-spec)
+                       (erc-ignored-reply-p           msg tgt proc)))
+            (let* ((sndr (erc-parse-user sender-spec))
+                   (nick (nth 0 sndr))
+                   (login (nth 1 sndr))
+                   (host (nth 2 sndr))
+                   (msgp (string= cmd "PRIVMSG"))
+                   (noticep (string= cmd "NOTICE"))
+                   ;; S.B. downcase *both* tgt and current nick
+                   (privp (erc-current-nick-p tgt))
+                   s buffer
+                   fnick)
+              (setf (erc-response.contents parsed) msg)
+              (setq buffer (erc-get-buffer (if privp nick tgt) proc))
+              (when buffer
+                (with-current-buffer buffer
+                  ;; update the chat partner info.  Add to the list if private
+                  ;; message.  We will accumulate private identities indefinitely
+                  ;; at this point.
+                  (erc-update-channel-member (if privp nick tgt) nick nick
+                                             privp nil nil host login nil nil t)
+                  (let ((cdata (erc-get-channel-user nick)))
+                    (setq fnick (funcall erc-format-nick-function
+                                         (car cdata) (cdr cdata))))))
+              (cond
+                ((erc-is-message-ctcp-p msg)
+                 (setq s (if msgp
+                             (erc-process-ctcp-query proc parsed nick login host)
+                             (erc-process-ctcp-reply proc parsed nick login host
+                                                     (match-string 1 msg)))))
+                (t
+                 (setcar erc-server-last-peers nick)
+                 (setq s (erc-format-privmessage
+                          (or fnick nick) msg
+                          ;; If buffer is a query buffer,
+                          ;; format the nick as for a channel.
+                          (and (not (and buffer
+                                         (erc-query-buffer-p buffer)
+                                         erc-format-query-as-channel-p))
+                               privp)
+                          msgp))))
+              (when s
+                (if (and noticep privp)
+                    (progn
+                      (run-hook-with-args 'erc-echo-notice-always-hook
+                                          s parsed buffer nick)
+                      (run-hook-with-args-until-success
+                       'erc-echo-notice-hook s parsed buffer nick))
+                    (erc-display-message parsed nil buffer s)))
+              (when (string= cmd "PRIVMSG")
+                (erc-auto-query proc parsed)))))))
+
+(provide 'pjb-erc-filter)
diff --git a/pjb-erc-speak.el b/pjb-erc-speak.el
new file mode 100644
index 0000000..869eeb3
--- /dev/null
+++ b/pjb-erc-speak.el
@@ -0,0 +1,223 @@
+;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               pjb-erc-speak.el
+;;;;LANGUAGE:           emacs lisp
+;;;;SYSTEM:             POSIX
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    erc speak stuff.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2014-02-24 <PJB> Extracted from ~/rc/emacs-common.el
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2014 - 2014
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(require 'cl)
+(require 'erc)
+
+
+(defvar *pjb-speak-file-counter* 0)
+
+(defun pjb-speak-file ()
+  (format "%s/speak-%d.txt" *tempdir* (incf *pjb-speak-file-counter*)))
+
+
+(defvar *pjb-speak-last-message* nil)
+
+(defun speak (message)
+  (interactive "sMessage: ")
+  (let ((file (pjb-speak-file)))
+    (with-current-buffer (get-buffer-create " *speak text*")
+      (erase-buffer)
+      (insert message)
+      (setf *pjb-speak-last-message* message)
+      (write-region (point-min) (point-max) file))
+    (shell-command (format "speak -f %s" file))))
+
+(defalias 'say 'speak)
+
+(defun speak-repeat ()
+  (interactive)
+  (speak *pjb-speak-last-message*))
+
+
+
+(defparameter *pjb-erc-spoken-nicks*
+  '(("\\<e1f\\>"          . "elf")
+    ("\\<tali[0-9]+"      . "tali")
+    ("\\<fsbot\\>"        . "F. S. Bot")
+    ("\\<qu1j0t3\\>"      . "quijote")
+    ("\\<chromaticwt\\>"  . "chromatic W. T.")
+    ("\\<jcowan\\>"       . "J. Cowan")
+    ("\\<cky\\>"          . "C. K. Y.")
+    ("\\<pjb\\>"          . "Pascal")
+    ("\\<H4ns\\>"         . "Hans")
+    ("\\<Corman[0-9]+\\>" . "Corman"))
+  "An a-list mapping regexps of nicks to the corresponding text to be read aloud.")
+
+
+(defun pjb-erc-spoken-nick (nick)
+  "
+RETURN:  The text to be read aloud for the `nick' in `*pjb-erc-spoken-nicks*'.
+"
+  (let ((entry (assoc* nick *pjb-erc-spoken-nicks*
+                       :test (lambda (nick ref) (string-match ref nick)))))
+    (if entry
+        (cdr entry)
+        nick)))
+
+
+(defun erc-response.recipient (response)
+  (first (erc-response.command-args response)))
+
+(defun erc-response.sender-nick (response)
+  (let ((sender (erc-response.sender response)))
+   (subseq sender 0 (position ?! sender))))
+
+
+(defparameter *pjb-erc-massage-substitutions*
+  '(("\\<pjb\\>"                 "Pascal")
+    ("\\<CL\\>"                  "See Ell")
+    ("\\<C-"                     "Control-")
+    ("\\<M-"                     "Meta-")
+    ("\\<A-"                     "Alt-")
+    ("\\<S-"                     "Shift-")
+    ("\\<s-"                     "super-")
+    ("\\<H-"                     "Hyper-")
+    ("\\(:-?)\\|(-?:\\)"         "AhAhAh!")
+    (":-?("                      "BooBooBoo!")
+    (":-/"                       "muek")
+    (":-?[Pp]"                   "bruu")
+    ("\\<\\(ty\\|thx\\)\\>"      "Thank you!")
+    ("\\<LOL\\>"                 "AhAhAh! Laughting Out Loud!")
+    ("\\<ROFL\\>"                "AhAhAh! Rolling On the Floor!")
+    ("\\<hrm\\>"                 "errrmmm")
+    ("\\<btw\\>"                 "by the way")
+    ("\\<wtf\\>"                 "what the fuck")
+    ("\\<imo\\>"                 "in my opinion")
+    ("\\<imho\\>"                "in my humble opinion")
+    ("\\<imnsho\\>"              "in my not so humble opinion")))
+
+
+(defun pjb-erc-massage-message (message)
+  (with-current-buffer (get-buffer-create "*pjb massage text*")
+    (erase-buffer)
+    (insert message)
+    (let ((case-fold-search nil))
+      (loop
+         for (reg sub) in *pjb-erc-massage-substitutions*
+         do (progn
+              (goto-char (point-min))
+              (loop
+                 while (re-search-forward reg nil t)
+                 do (progn
+                      (delete-region (match-beginning 0) (match-end 0))
+                      (insert sub))))))
+    (buffer-string)))
+
+
+
+(defvar *pjb-erc-speak-reject-recipient* '()
+  "can be:
+nil   don't reject any channel.
+:all  reject every channel.
+or a list of nicknames or channel names \"nick\" \"\#chan\"
+to reject (never speak them aloud).
+See: `*pjb-erc-speak-reject-sender*', `*pjb-erc-speak-accept-sender*',
+      and `pjb-erc-privmsg-meat'.
+
+Messages are spoken if the recipient
+")
+
+(defvar *pjb-erc-speak-reject-sender* '()
+  "can be:
+nil   don't reject anybody.
+:all  reject everybody.
+or a list of nicknames or channel names \"nick\" \"\#chan\"
+to reject (never speak them aloud).
+See: `*pjb-erc-speak-reject-recipient*', `*pjb-erc-speak-accept-sender*',
+      and `pjb-erc-privmsg-meat'.
+")
+
+(defvar *pjb-erc-speak-accept-sender* '()
+  "can be:
+nil   don't accept anything.
+:all  accept everything.
+or a list of nicknames or channel names \"nick\" \"\#chan\"
+to accept (speak them aloud).
+See: `*pjb-erc-speak-reject-recipient*', `*pjb-erc-speak-reject-sender*',
+      and `pjb-erc-privmsg-meat'.
+")
+
+(setf *pjb-erc-speak-reject-recipient* '("#emacs")
+      *pjb-erc-speak-reject-recipient* :all
+      *pjb-erc-speak-reject-sender*    :all
+      *pjb-erc-speak-accept-sender*    '("Posterdati" "pjb-"))
+
+
+(defvar *pjb-erc-speak-last-speaker* nil)
+
+
+(defun pjb-erc-privmsg-meat (process response)
+  "The messages are spoken if the sender is in `*pjb-erc-speak-accept-sender*',
+or the sender is not in `*pjb-erc-speak-reject-sender*',
+or the recipient is not in `*pjb-erc-speak-reject-recipient*',
+"
+  (when (or
+         (case *pjb-erc-speak-accept-sender*
+           ((nil)    nil)
+           ((:all t) t)
+           (otherwise (member* (erc-response.sender-nick response)
+                               *pjb-erc-speak-accept-sender* :test 'string=)))
+         (case *pjb-erc-speak-reject-sender*
+           ((nil)    t)
+           ((:all t) nil)
+           (otherwise (not (member* (erc-response.sender-nick response)
+                                    *pjb-erc-speak-reject-sender* :test 'string=))))
+         (case *pjb-erc-speak-reject-recipient*
+           ((nil)    t)
+           ((:all t) nil)
+           (otherwise (not (member* (erc-response.recipient response)
+                                    *pjb-erc-speak-reject-recipient* :test 'string=)))))
+    (speak (let* ((nick (pjb-erc-spoken-nick (erc-response.sender-nick response)))
+                  (chan (pjb-erc-spoken-nick (remove ?# (erc-response.recipient response))))
+                  (mesg (pjb-erc-massage-message (erc-response.contents response))))
+             (if (equal *pjb-erc-speak-last-speaker*
+                        (cons nick chan))
+                 (format "%s" mesg)
+                 (progn
+                   (setf *pjb-erc-speak-last-speaker* (cons nick chan))
+                   (format "%s said to %s: ... %s" nick chan mesg))))))
+  nil)
+
+
+(defun pjb-erc-speak-on ()
+  (interactive)
+  (pushnew 'pjb-erc-privmsg-meat  erc-server-PRIVMSG-functions))
+
+(defun pjb-erc-speak-off  ()
+  (interactive)
+  (setf erc-server-PRIVMSG-functions
+        (remove 'pjb-erc-privmsg-meat  erc-server-PRIVMSG-functions)))
+
+(provide 'pjb-erc-speak)
diff --git a/pjb-java-generate.el b/pjb-java-generate.el
new file mode 100644
index 0000000..c21d89b
--- /dev/null
+++ b/pjb-java-generate.el
@@ -0,0 +1,145 @@
+(defparameter *dirpath* "~/src/Android-SDK/ubudu-sdk/src/com/ubudu/sdk/dto/")
+
+(defparameter *java-current-package* 'com.example)
+(defparameter *java-operators* '(+ - * / < > <= >= == ! && ||))
+
+(defparameter *java-predefined-classes* '((java.lang . Object)
+                                          (java.lang . String)
+                                          (java.lang . Boolean)
+                                          (java.lang . Integer)
+                                          (java.lang . Double)
+                                          (java.util . Date)
+                                          (java.util . Vector)))
+
+
+
+(defun java-in-package (package)
+  (setf *java-current-package* package)
+  (insert (format "package %s;\n\n" *java-current-package*)))
+
+(defun java-import (full-qualified-class-name)
+  (insert (format "import %s;\n" full-qualified-class-name)))
+
+(defun* java-class (class-name &key superclass interfaces throws import-thunk body-thunk)
+  (when import-thunk (funcall import-thunk))
+  (insert (format  "public class %s" class-name))
+  (when superclass
+    (insert (format " extends %s" superclass)))
+  (when interfaces
+    (insert (format " implements %s" (join interfaces ","))))
+  (when throws
+    (insert (format " throws %s" (join throws ","))))
+  (insert "{\n")
+  (when body-thunk (funcall body-thunk))
+  (insert "\n}\n"))
+
+(defun java-parameters (parameters)
+  (insert (format "(%s)" (join (mapcar (lambda (parameter)
+                                         (destructuring-bind (name type) parameter
+                                           (format "%s %s" (prepare-type type) name)))
+                                       parameters)
+                               ","))))
+
+(defun java-expression (expression)
+  (if (atom expression)
+    (format "%s" expression)
+    (let ((op (first expression))
+          (args (rest expression)))
+      (cond
+       ((member op *java-operators*)
+        (if (endp (rest args))
+          (format "(%s%s)" op (java-expression (first args)))
+          (format "(%s)" (join (mapcar (function java-expression) args)
+                               (format "%s" op)))))
+       ((eq op '\.)
+        (java-send (first args) (second args) (cddr args)))
+       (t
+        (java-send nil op args))))))
+
+(defun java-arguments (arguments)
+  (insert (format "(%s)" (join (mapcar (function java-expression) arguments) ","))))
+
+(defun arguments-from-parameters (parameters)
+  (mapcar (lambda (parameter)
+            (destructuring-bind (name type) parameter
+              name))
+          parameters))
+
+(defun java-send (recipient message arguments)
+  (insert (if recipient
+             (format "%s.%s" recipient message)
+             (format "%s" message)))
+  (java-arguments arguments))
+
+
+(defun java-constructor (class-name parameters)
+  (insert (format "public %s" class-name))
+  (java-parameters parameters)
+  (insert "{" "\n")
+  (java-send nil 'super (arguments-from-parameters parameters)) (insert ";" "\n")
+  (insert "}" "\n"))
+
+
+
+(defun java-class-package (class)
+  (car (rassoc class *java-predefined-classes*)))
+
+(defun java-fully-qualified-class (class)
+  (intern (format "%s.%s" (or (java-class-package class)
+                              *java-current-package*)
+                  class)))
+
+;; (java-fully-qualified-class 'Integer) java\.lang\.Integer
+;; (java-fully-qualified-class 'Geofence) com\.example\.Geofence
+
+(defun prepare-type (type)
+  (if (atom type)
+    type
+    (format "%s<%s>" (first type) (join (mapcar (function prin1-to-string) (rest type)) ","))))
+
+(defun* generate-java-class (file-name package-name class-name &key superclass interfaces throws fields)
+  (save-excursion
+    (find-file file-name)
+    (erase-buffer)
+    (insert "// -*- mode:java; coding:utf-8 -*-" "\n")
+    (insert "// Generated automatically by generate.el" "\n" "\n")
+    (java-in-package package-name)
+    (dolist (class (remove-duplicates (append (when superclass (list superclass))
+                                              interfaces
+                                              (mapcan (lambda (field)
+                                                        (if (atom (second field))
+                                                          (list (second field))
+                                                          (copy-list (second field))))
+                                                      fields))))
+      (java-import (java-fully-qualified-class class)))
+
+    (java-class class-name
+                :superclass superclass
+                :interfaces interfaces
+                :throws throws
+                :import-thunk (lambda ()
+                                (java-import 'com.google.gson.annotations.SerializedName))
+                :body-thunk   (lambda ()
+                                (java-constructor class-name '())
+                                (dolist (field fields)
+                                  (destructuring-bind (name type) field
+                                    (let ((ptype  (prepare-type type)))
+                                      (insert (format "@SerializedName(\"%s\")" name) "\n")
+                                      (insert (format "public %s %s;" ptype name) "\n")
+                                      )))))
+    (save-buffer 0)
+    (kill-buffer)))
+
+
+
+(defmacro define-entity (class &rest fields)
+  (let ((class-name (if (atom class)
+                      class
+                      (first class)))
+        (superclass (if (atom class)
+                      'Object
+                      (second (assoc :superclass (rest class))))))
+    `(generate-java-class ,(format "%s%s.java" *dirpath* class-name)
+                          'com.ubudu.sdk.dto ',class-name
+                          :superclass ',superclass
+                          :fields ',fields)))
diff --git a/pjb-loader.el b/pjb-loader.el
index 0207d8e..66b08b4 100644
--- a/pjb-loader.el
+++ b/pjb-loader.el
@@ -61,6 +61,8 @@
         "pjb-dodo.el"
         "pjb-emacs.el"
         "pjb-erc.el"
+        "pjb-erc-filter.el"
+        "pjb-erc-speak.el"
         "pjb-euro.el"
         "pjb-font.el"
         "pjb-html.el"
@@ -99,8 +101,7 @@
         (append *pjb-sources*
                 '(

-                  "pjb-vm-kill-file.el"
-
+
                   "pjb-computer-paper.el"
                   "pjb-constants.el"
                   "pjb-cvs.el"
@@ -131,14 +132,18 @@
                   ))))


- (when nil
+ (unless :obsolete
    '(
+     "pjb-vm"
+     "pjb-vm-kill-file.el"
+
      "pjb-banks-old.el"
      "pjb-c.el"
      "pjb-objc-mode.el"
      "pjb-comint"
      "slime-rpc.el"
      "split.el"
+
      ))


diff --git a/pjb-vm.el b/pjb-vm.el
new file mode 100644
index 0000000..b560c42
--- /dev/null
+++ b/pjb-vm.el
@@ -0,0 +1,590 @@
+;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               pjb-vm.el
+;;;;LANGUAGE:           emacs lisp
+;;;;SYSTEM:             POSIX
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    vm stuff -- obsolete.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2014-02-24 <PJB> Extracted from ~/rc/emacs-common.el
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2014 - 2014
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(when (require 'vm nil t)
+  (.EMACS "vm")
+  (require 'vm-vars)
+  (ignore-errors (load-library "vm-w3m"))
+
+
+
+  ;; (add-hook 'vm-mode-hook              'mc-install-read-mode)
+  ;; (add-hook 'vm-summary-mode-hook      'mc-install-read-mode)
+  ;; (add-hook 'vm-virtual-mode-hook      'mc-install-read-mode)
+  ;; (add-hook 'vm-mail-mode-hook         'mc-install-write-mode)
+  ;; (add-hook 'vm-presentation-mode-hook 'mc-install-write-mode)
+  (defun pjb-vm-summary-meat         () (when nil (set-frame-name "MAIL")))
+  (defun pjb-vm-mail-meat            () (when nil (set-frame-name "COMPOSE")))
+  (defun pjb-vm-reply-meat           () (inactivate-input-method))
+  (defun pjb-vm-arrived-message-meat () (pjb-vm-kill-subject-regexp "\\[SPAM\\]"))
+  (add-hook 'vm-summary-mode-hook    'pjb-vm-summary-meat)
+  (add-hook 'vm-mail-mode-hook       'pjb-vm-mail-meat)
+  (add-hook 'vm-reply-hook           'pjb-vm-reply-meat)
+  (add-hook 'vm-arrived-message-hook 'pjb-vm-arrived-message-meat)
+
+
+  (defun pjb-vm-delete-spam (count)
+    (interactive "p")
+    (vm-save-message "~/mail/spam.mbox" count)
+    (pjb-vm-delete-message count))
+
+  (defun pjb-vm-delete-message (count)
+    (interactive "p")
+    (vm-delete-message count)
+    (vm-next-message))
+
+  (defun pjb-vm-visit-folder-meat ()
+    (define-key vm-mode-map (kbd "d")     'pjb-vm-delete-message)
+    (define-key vm-mode-map (kbd "M-d")   'pjb-vm-delete-spam)
+    (define-key vm-mode-map (kbd "o")     'vm-save-message)
+    (define-key vm-mode-map (kbd "r")     'vm-followup-include-text)
+    (define-key vm-mode-map (kbd "s")     'vm-save-folder)
+    (local-set-key          (kbd "c")     'vm-save-message))
+
+  (add-hook 'vm-visit-folder-hook 'pjb-vm-visit-folder-meat)
+
+  (unless (<= 23 emacs-major-version)
+    (keyboard-translate (aref (kbd "M-S-d") 0) (aref (kbd "M-S-d") 0))
+    (keyboard-translate (aref (kbd "M-D")   0) (aref (kbd "M-D")   0)))
+
+  ;; (defun vm-from-biff ()
+  ;;   (interactive)
+  ;;   (select-frame (make-frame))
+  ;;   (vm-register-frame (vm-selected-frame))
+  ;;   (when vm-warp-mouse-to-new-frame
+  ;;     (vm-warp-mouse-to-frame-maybe (vm-selected-frame)))
+  ;;   (vm))
+
+  (when (load "vm-sort" *pjb-load-noerror* *pjb-load-silent*)
+    (defun vm-sort-compare-author (m1 m2)
+      "Let's sort by domain first"
+      (let ((s1 (vm-su-from m1))
+            (s2 (vm-su-from m2))
+            l1 d1 l2 d2)
+        (let ((@-pos (position (character "@") s1)))
+          (if @-pos
+              (setf d1 (subseq s1 (1+ @-pos))
+                    l1 (subseq s1 0 @-pos))
+              (setf d1 ""
+                    l1 s1)))
+        (let ((@-pos (position (character "@") s2)))
+          (if @-pos
+              (setf d2 (subseq s2 (1+ @-pos))
+                    l2 (subseq s2 0 @-pos))
+              (setf d2 ""
+                    l2 s2)))
+        (cond ((string-equal s1 s2) '=)
+              ((string-equal d1 d2)
+               (cond ((string-lessp l1 l2) t)
+                     ((string-equal l1 l2)
+                      (let ((f1 (vm-su-full-name m1))
+                            (f2 (vm-su-full-name m2)))
+                        (cond ((string-lessp f1 f2) t)
+                              ((string-lessp f1 f2) '=)
+                              (t nil))))
+                     (t nil)))
+              ((string-lessp d1 d2) t)
+              (t nil))))
+    ) ;;when vm-sort
+
+
+
+  ;; (catch :found
+  ;;   (let ((version emacs-version)
+  ;;         (next
+  ;;          (lambda ()
+  ;;            (cond
+  ;;              ((null version)          (throw :found :default))
+  ;;              ((= 0 (length version))
+  ;;               (setf version nil)
+  ;;               (concatenate 'string (NAMESTRING (USER-HOMEDIR-PATHNAME))
+  ;;                            "bin/movemail"))
+  ;;              (t (prog1
+  ;;                     (format "/usr/local/libexec/emacs/%s/%s/movemail"
+  ;;                       version system-configuration)
+  ;;                   (string-match "^\\(\\([0-9][.0-9]*\\)\\.\\)?[0-9]+$" version)
+  ;;                   (setq version (or (match-string 2 version) ""))))))))
+  ;;     (do ((path (funcall next) (funcall next)))
+  ;;         (nil)
+  ;;       (when (file-exists-p path)
+  ;;         (setq vm-movemail-program  path)
+  ;;         (throw :found :one)))))
+
+  ;; ;; movemail: No locks available for /larissa//var/spool/mail/pjb
+  ;; ;; /usr/local/libexec/emacs/21.3/i686-pc-linux-gnu/movemail exited with code 1
+  ;; (setq vm-movemail-program
+  ;;       (concatenate 'string  (NAMESTRING (USER-HOMEDIR-PATHNAME)) "bin/movemail"))
+
+;;; '(vm-imap-server-list (quote ("imap:imap.afaa.asso.fr:143:inbox:login:pjb:pari-fle")))
+
+
+
+  ;; rmail -> vm
+  ;;(defalias 'rmail 'vm)
+  ;;(defalias 'rmail-input 'vm-visit-folder)
+  ;;(defun rmail       () (interactive) (error "Use mail in a shell!"))
+  ;;(defun vm          () (interactive) (error "Use mail in a shell!"))
+  ;;(defun rmail-input () (interactive) (error "Use mail in a shell!"))
+
+  ;; (defmacro advise-replace (fname parameters body)
+  ;;   (let ((aname (intern (format "pjb-adrep-%s" fname))))
+  ;;     `(progn
+  ;;        (defadvice ,fname
+  ;;            (around ,aname  first  ,parameters  activate)
+  ;;          ,body)
+  ;;        (ad-activate (quote ,fname)))
+  ;;     )) ;;advise-replace
+  ;; (put 'advise-replace      'lisp-indent-function 2)
+  ;;
+  ;;
+  ;; (advise-replace rmail-sort-by-correspondent (reverse)
+  ;;   (vm-sort-messages  (if reverse "reversed-author" "author")))
+  ;;
+  ;; (advise-replace rmail-sort-by-date          (reverse)
+  ;;   (vm-sort-messages  (if reverse "reversed-date" "date")))
+  ;;
+  ;; (advise-replace rmail-sort-by-labels        (reverse)
+  ;;   (error "Not implemented with VM."))
+  ;;
+  ;; (advise-replace rmail-sort-by-lines         (reverse)
+  ;;   (vm-sort-messages  (if reverse "reversed-line-count" "line-count")))
+  ;;
+  ;; (advise-replace rmail-sort-by-recipient     (reverse)
+  ;;   (vm-sort-messages  (if reverse "reversed-recipients" "recipients")))
+  ;;
+  ;; (advise-replace rmail-sort-by-subject       (reverse)
+  ;;   (vm-sort-messages  (if reverse "reversed-subject" "subject")))
+
+
+  ;; (defadvice vm-mime-attach-object
+  ;;     (before pjb-removemime-vm-mime-attach-object nil activate)
+  ;;   (save-restriction
+  ;;     (pjb-mail-narrow-to-headers)
+  ;;     (pjb-mail-remove-header "^\\(MIME-Version:\\|Content-\\)" t))
+  ;;   )
+  ;; (ad-activate 'vm-mime-attach-object)
+
+
+
+  (when (require 'vm-pop nil t)
+    (defun vm-pop-cleanup-region (start end)
+      (setq end (vm-marker end))
+      (save-excursion
+        (goto-char start)
+        ;; CRLF -> LF
+        (while (and (< (point) end) (search-forward "\r\n"  end t))
+          (replace-match "\n" t t))
+        (goto-char start)
+        (while (and (< (point) end) (search-forward "^\\(From .*\\)" end t))
+          (message "inserting a new line before %S" (buffer-substring (match-beginning 0) (match-end 0)))
+          (goto-char (match-beginning 0))
+          (insert "\n\n")
+          (forward-line))
+        ;; (goto-char start)
+        ;; chop leading dots
+        ;; (while (and (< (point) end) (re-search-forward "^\\."  end t))
+        ;;   (replace-match "" t t)
+        ;;   (forward-char))
+        )
+      (set-marker end nil)))
+
+
+  (defun vm (&optional folder read-only access-method)
+    "Read mail under Emacs.
+Optional first arg FOLDER specifies the folder to visit.  It defaults
+to the value of vm-primary-inbox.  The folder buffer is put into VM
+mode, a major mode for reading mail.
+
+Prefix arg or optional second arg READ-ONLY non-nil indicates
+that the folder should be considered read only.  No attribute
+changes, message additions or deletions will be allowed in the
+visited folder.
+
+Visiting the primary inbox normally causes any contents of the system mailbox to
+be moved and appended to the resulting buffer.  You can disable this automatic fetching of mail by setting `vm-auto-get-new-mail' to nil.
+
+All the messages can be read by repeatedly pressing SPC.  Use `n'ext and
+`p'revious to move about in the folder.  Messages are marked for
+deletion with `d', and saved to another folder with `s'.  Quitting VM
+with `q' saves the buffered folder to disk, but does not expunge
+deleted messages.  Use `###' to expunge deleted messages.
+
+See the documentation for vm-mode for more information."
+    (interactive (list nil current-prefix-arg))
+    (vm-session-initialization)
+    ;; set inhibit-local-variables non-nil to protect
+    ;; against letter bombs.
+    ;; set enable-local-variables to nil for newer Emacses
+    (catch 'done
+      ;; deduce the access method if none specified
+      (if (null access-method)
+          (let ((f (or folder vm-primary-inbox)))
+            (cond ((and vm-recognize-imap-maildrops
+                        ;; f could be a buffer
+                        (stringp f)
+                        (string-match vm-recognize-imap-maildrops f))
+                   (setq access-method 'imap
+                         folder f))
+                  ((and vm-recognize-pop-maildrops
+                        ;; f could be a buffer
+                        (stringp f)
+                        (string-match vm-recognize-pop-maildrops f))
+                   (setq access-method 'pop
+                         folder f)))))
+      (let ((full-startup (not (bufferp folder)))
+            (did-read-index-file nil)
+            folder-buffer first-time totals-blurb
+            folder-name remote-spec
+            preserve-auto-save-file)
+        (cond ((eq access-method 'pop)
+               (setq remote-spec (vm-pop-find-spec-for-name folder))
+               (if (null remote-spec)
+                   (error "No such POP folder: %s" folder))
+               (setq folder-name folder)
+               ;; Prior to VM 7.11, we computed the cache filename
+               ;; based on the full POP spec including the password
+               ;; if it was in the spec.  This meant that every
+               ;; time the user changed his password, we'd start
+               ;; visiting the wrong (and probably nonexistent)
+               ;; cache file.
+               ;;
+               ;; To fix this we do two things.  First, migrate the
+               ;; user's caches to the filenames based in the POP
+               ;; sepc without the password.  Second, we visit the
+               ;; old password based filename if it still exists
+               ;; after trying to migrate it.
+               ;;
+               ;; For VM 7.16 we apply the same logic to the access
+               ;; methods, pop, pop-ssh and pop-ssl and to
+               ;; authentication method and service port, which can
+               ;; also change and lead us to visit a nonexistent
+               ;; cache file.  The assumption is that these
+               ;; properties of the connection can change and we'll
+               ;; still be accessing the same mailbox on the
+               ;; server.
+               (let ((f-pass (vm-pop-make-filename-for-spec remote-spec))
+                     (f-nopass (vm-pop-make-filename-for-spec remote-spec t))
+                     (f-nospec (vm-pop-make-filename-for-spec remote-spec t t)))
+                 (cond ((or (string= f-pass f-nospec)
+                            (file-exists-p f-nospec))
+                        nil )
+                       ((file-exists-p f-pass)
+                        ;; try to migrate
+                        (condition-case nil
+                            (rename-file f-pass f-nospec)
+                          (error nil)))
+                       ((file-exists-p f-nopass)
+                        ;; try to migrate
+                        (condition-case nil
+                            (rename-file f-nopass f-nospec)
+                          (error nil))))
+                 ;; choose the one that exists, password version,
+                 ;; nopass version and finally nopass+nospec
+                 ;; version.
+                 (cond ((file-exists-p f-pass)
+                        (setq folder f-pass))
+                       ((file-exists-p f-nopass)
+                        (setq folder f-nopass))
+                       (t
+                        (setq folder f-nospec)))))
+              ((eq access-method 'imap)
+               (setq remote-spec folder
+                     folder-name (or (nth 3 (vm-imap-parse-spec-to-list
+                                             remote-spec))
+                                     folder)
+                     folder (vm-imap-make-filename-for-spec remote-spec))))
+        (setq folder-buffer
+              (if (bufferp folder)
+                  folder
+                  (let ((file (or folder (expand-file-name vm-primary-inbox
+                                                           vm-folder-directory))))
+                    (if (file-directory-p file)
+                        ;; MH code perhaps... ?
+                        (error "%s is a directory" file)
+                        (or (vm-get-file-buffer file)
+                            (let ((default-directory
+                                   (or (and vm-folder-directory
+                                            (expand-file-name vm-folder-directory))
+                                       default-directory))
+                                  (inhibit-local-variables t)
+                                  (enable-local-variables nil)
+                                  (enable-local-eval nil)
+                                  ;; for Emacs/MULE
+                                  (default-enable-multibyte-characters nil)
+                                  ;; for XEmacs/Mule
+                                  (coding-system-for-read
+                                   (vm-line-ending-coding-system)))
+                              (message "Reading %s..." file)
+                              (prog1 (find-file-noselect file)
+                                ;; update folder history
+                                (let ((item (or remote-spec folder
+                                                vm-primary-inbox)))
+                                  (if (not (equal item (car vm-folder-history)))
+                                      (setq vm-folder-history
+                                            (cons item vm-folder-history))))
+                                (message "Reading %s... done" file))))))))
+        (set-buffer folder-buffer)
+        (cond ((memq access-method '(pop imap))
+               (if (not (equal folder-name (buffer-name)))
+                   (rename-buffer folder-name t))))
+        (if (and vm-fsfemacs-mule-p enable-multibyte-characters)
+            (set-buffer-multibyte nil))
+        ;; for MULE
+        ;;
+        ;; If the file coding system is not a no-conversion variant,
+        ;; make it so by encoding all the text, then setting the
+        ;; file coding system and decoding it.  This situation is
+        ;; only possible if a file is visited and then vm-mode is
+        ;; run on it afterwards.
+        ;;
+        ;; There are separate code blocks for FSF Emacs and XEmacs
+        ;; because the coding systems have different names.
+        (defvar buffer-file-coding-system)
+        (if (and (or vm-xemacs-mule-p vm-xemacs-file-coding-p)
+                 (not (eq (get-coding-system buffer-file-coding-system)
+                          (get-coding-system 'no-conversion-unix)))
+                 (not (eq (get-coding-system buffer-file-coding-system)
+                          (get-coding-system 'no-conversion-dos)))
+                 (not (eq (get-coding-system buffer-file-coding-system)
+                          (get-coding-system 'no-conversion-mac)))
+                 (not (eq (get-coding-system buffer-file-coding-system)
+                          (get-coding-system 'binary))))
+            (let ((buffer-read-only nil)
+                  (omodified (buffer-modified-p)))
+              (unwind-protect
+                   (progn
+                     (encode-coding-region (point-min) (point-max)
+                                           buffer-file-coding-system)
+                     (set-buffer-file-coding-system 'no-conversion nil)
+                     (decode-coding-region (point-min) (point-max)
+                                           buffer-file-coding-system))
+                (set-buffer-modified-p omodified))))
+        (if (and vm-fsfemacs-mule-p (null buffer-file-coding-system))
+            (set-buffer-file-coding-system 'raw-text nil))
+        (if (and vm-fsfemacs-mule-p
+                 (not (eq (coding-system-base buffer-file-coding-system)
+                          (coding-system-base 'raw-text-unix)))
+                 (not (eq (coding-system-base buffer-file-coding-system)
+                          (coding-system-base 'raw-text-mac)))
+                 (not (eq (coding-system-base buffer-file-coding-system)
+                          (coding-system-base 'raw-text-dos)))
+                 (not (eq (coding-system-base buffer-file-coding-system)
+                          (coding-system-base 'no-conversion))))
+            (let ((buffer-read-only nil)
+                  (omodified (buffer-modified-p)))
+              (unwind-protect
+                   (progn
+                     (encode-coding-region (point-min) (point-max)
+                                           buffer-file-coding-system)
+                     (set-buffer-file-coding-system 'raw-text nil)
+                     (decode-coding-region (point-min) (point-max)
+                                           buffer-file-coding-system))
+                (set-buffer-modified-p omodified))))
+        (vm-check-for-killed-summary)
+        (vm-check-for-killed-presentation)
+        ;; If the buffer's not modified then we know that there can be no
+        ;; messages in the folder that are not on disk.
+        (or (buffer-modified-p) (setq vm-messages-not-on-disk 0))
+        (setq first-time (not (eq major-mode 'vm-mode))
+              preserve-auto-save-file (and buffer-file-name
+                                           (not (buffer-modified-p))
+                                           (file-newer-than-file-p
+                                            (make-auto-save-file-name)
+                                            buffer-file-name)))
+        ;; Force the folder to be read only if the auto
+        ;; save file contains information the user might not
+        ;; want overwritten, i.e. recover-file might be
+        ;; desired.  What we want to avoid is an auto-save.
+        ;; Making the folder read only will keep
+        ;; subsequent actions from modifying the buffer in a
+        ;; way that triggers an auto save.
+        ;;
+        ;; Also force the folder read-only if it was read only and
+        ;; not already in vm-mode, since there's probably a good
+        ;; reason for this.
+        (setq vm-folder-read-only (or preserve-auto-save-file read-only
+                                      (default-value 'vm-folder-read-only)
+                                      (and first-time buffer-read-only)))
+        ;; If this is not a VM mode buffer then some initialization
+        ;; needs to be done
+        (if first-time
+            (progn
+              (buffer-disable-undo (current-buffer))
+              (abbrev-mode 0)
+              (auto-fill-mode 0)
+              ;; If an 8-bit message arrives undeclared the 8-bit
+              ;; characters in it should be displayed using the
+              ;; user's default face charset, rather than as octal
+              ;; escapes.
+              (vm-fsfemacs-nonmule-display-8bit-chars)
+              (vm-mode-internal access-method)
+              (cond ((eq access-method 'pop)
+                     (vm-set-folder-pop-maildrop-spec remote-spec))
+                    ((eq access-method 'imap)
+                     (vm-set-folder-imap-maildrop-spec remote-spec)))
+              ;; If the buffer is modified we don't know if the
+              ;; folder format has been changed to be different
+              ;; from index file, so don't read the index file in
+              ;; that case.
+              (if (not (buffer-modified-p))
+                  (setq did-read-index-file (vm-read-index-file-maybe)))))
+
+        ;; builds message list, reads attributes if they weren't
+        ;; read from an index file.
+        (vm-assimilate-new-messages nil (not did-read-index-file) nil t)
+
+        (if (and first-time (not did-read-index-file))
+            (progn
+              (vm-gobble-visible-header-variables)
+              (vm-gobble-bookmark)
+              (vm-gobble-pop-retrieved)
+              (vm-gobble-imap-retrieved)
+              (vm-gobble-summary)
+              (vm-gobble-labels)))
+
+        (if first-time
+            (vm-start-itimers-if-needed))
+
+        ;; make a new frame if the user wants one.  reuse an
+        ;; existing frame that is showing this folder.
+        (if (and full-startup
+                 ;; this so that "emacs -f vm" doesn't create a frame.
+                 this-command)
+            (apply 'vm-goto-new-folder-frame-maybe
+                   (if folder '(folder) '(primary-folder folder))))
+
+        ;; raise frame if requested and apply startup window
+        ;; configuration.
+        (if full-startup
+            (let ((buffer-to-display (or vm-summary-buffer
+                                         vm-presentation-buffer
+                                         (current-buffer))))
+              (vm-display buffer-to-display buffer-to-display
+                          (list this-command)
+                          (list (or this-command 'vm) 'startup))
+              (if vm-raise-frame-at-startup
+                  (vm-raise-frame))))
+
+        ;; say this NOW, before the non-previewers read a message,
+        ;; alter the new message count and confuse themselves.
+        (if full-startup
+            (progn
+              ;; save blurb so we can repeat it later as necessary.
+              (set-buffer folder-buffer)
+              (setq totals-blurb (vm-emit-totals-blurb))
+              (and buffer-file-name
+                   (vm-store-folder-totals buffer-file-name (cdr vm-totals)))))
+
+        (vm-thoughtfully-select-message)
+        (vm-update-summary-and-mode-line)
+        ;; need to do this after any frame creation because the
+        ;; toolbar sets frame-specific height and width specifiers.
+        (vm-toolbar-install-or-uninstall-toolbar)
+
+        (and vm-use-menus (vm-menu-support-possible-p)
+             (vm-menu-install-visited-folders-menu))
+
+        (if full-startup
+            (progn
+              (if (and (vm-should-generate-summary)
+                       ;; don't generate a summary if recover-file is
+                       ;; likely to happen, since recover-file does
+                       ;; not work in a summary buffer.
+                       (not preserve-auto-save-file))
+                  (vm-summarize t nil))
+              ;; raise the summary frame if the user wants frames
+              ;; raised and if there is a summary frame.
+              (if (and vm-summary-buffer
+                       vm-mutable-frames
+                       vm-frame-per-summary
+                       vm-raise-frame-at-startup)
+                  (vm-raise-frame))
+              ;; if vm-mutable-windows is nil, the startup
+              ;; configuration can't be applied, so do
+              ;; something to get a VM buffer on the screen
+              (if vm-mutable-windows
+                  (vm-display nil nil (list this-command)
+                              (list (or this-command 'vm) 'startup))
+                  (save-excursion
+                    (switch-to-buffer (or vm-summary-buffer
+                                          vm-presentation-buffer
+                                          (current-buffer)))))))
+
+        (if vm-message-list
+            ;; don't decode MIME if recover-file is
+            ;; likely to happen, since recover-file does
+            ;; not work in a presentation buffer.
+            (let ((vm-auto-decode-mime-messages
+                   (and vm-auto-decode-mime-messages
+                        (not preserve-auto-save-file))))
+              (vm-preview-current-message)))
+
+        (run-hooks 'vm-visit-folder-hook)
+
+        ;; Warn user about auto save file, if appropriate.
+        (if (and full-startup preserve-auto-save-file)
+            (message
+             (substitute-command-keys
+              "Auto save file is newer; consider \\[recover-file].  FOLDER IS READ ONLY.")))
+        ;; if we're not doing a full startup or if doing more would
+        ;; trash the auto save file that we need to preserve,
+        ;; stop here.
+        (if (or (not full-startup) preserve-auto-save-file)
+            (throw 'done t))
+
+        (if full-startup
+            (message totals-blurb))
+
+        (if (and vm-auto-get-new-mail
+                 (not vm-block-new-mail)
+                 (not vm-folder-read-only))
+            (progn
+              (message "Checking for new mail for %s..."
+                       (or buffer-file-name (buffer-name)))
+              (if (vm-get-spooled-mail t)
+                  (progn
+                    (setq totals-blurb (vm-emit-totals-blurb))
+                    (if (vm-thoughtfully-select-message)
+                        (vm-preview-current-message)
+                        (vm-update-summary-and-mode-line))))
+              (message totals-blurb)))
+
+        ;; Display copyright and copying info.
+        (if (and (interactive-p) (not vm-startup-message-displayed))
+            (progn
+              (vm-display-startup-message)
+              (if (not (input-pending-p))
+                  (message totals-blurb)))))))
+
+  (provide 'pjb-vm)) ;;when
ViewGit