I made some emacs programs.
email: joneworlds@mailbox.org

I may not be an emacs whiz, but I sure do like the
word  "whiz", it's  fun to  say. Whatever,  here's
some programs.


Get an email link.

I  get all  this mail  from Cliff,  all the  time,
because  he thinks  I stole  his stuff...  Where's
my 3/4" sockets, Jone?  Where's my corvette zippo,
Jone? Where's my Gringo  Bandito hot sauce, Jone?"
I mean, I do actually have the sockets around here
someplace, but  that bandito sauce was  lame and I
didn't  take  it. I  mean,  we  did use  half  the
bottle, but  Del said they put  it back, probably,
and the point is I don't have it. Whatever, it's a
lot  of emails  I got  to  get back  on, and  yeah
there's some stuff  I got to dig  up. And org-mode
is great for keeping track of stuff to do.

There's this thing  you can do in  org mode, where
you go  C-c C-l  and you insert  a link  to stuff.
Like a file, or one  of Cliff's emails, from Rmail
mode.  But  I find it  easier to actually  go into
rmail, find the  email, and then when  I'm there I
make a link to it.  This program below adds an "L"
command to rmail's message reading mode, that puts
a hyperlink to the  email you're reading, onto the
clipboard (kill). Once you got that, you flip back
to org  mode and paste  (yank) it in  wherever you
want it. It's  just better than C-c  C-l rmail.  I
think.

(progn
  (defun jw-org-rmail-link ()
    (interactive)
    (save-excursion
      (rmail-toggle-header 0)
      (goto-char (point-min))
      (when (search-forward-regexp "^Message-ID:" nil t)
        (let (p1 p2 id file)
          (setq file (buffer-file-name))
          (search-forward "<" nil t)
          (setq p1 (point))
          (search-forward ">" nil t)
          (setq p2 (- (point) 1))
          (setq id (buffer-substring p1 p2))
          (message id)
          (with-temp-buffer
            (insert "rmail:")
            (insert file)
            (insert "#")
            (insert id)
            (goto-char (point-min))
            (kill-ring-save (point-min) (point-max))
            (message (buffer-string)))
          (rmail-toggle-header 1)))))
  (add-hook
   'rmail-mode-hook
   (lambda () 
     (define-key rmail-mode-map "L"
       (lambda () (interactive) (jw-org-rmail-link))))))



A bunch of blinking lights.

This one  puts up  a rectangle  of dots,  and then
flips some of them on and  off in a random sort of
way. I guess  it's sort of fun to watch  it do its
thing and blink away in  an emacs window while you
type away at your stuff.  It runs 10 timers. There
is  an extra  bit at  the end  to cancel  them all
which is how you shut it off.

(progn
  (get-buffer-create "1")
  (with-current-buffer "1"
    (erase-buffer)
    (goto-char (point-min))
    (dotimes (i 10)
      (insert (make-string 40 ?. ))
      (newline)))
  (setq jw-place (make-list 10 nil))
  (setq jw-timers (make-list 10 nil))
  (setq jw-colors
        (list "SeaGreen4" "gold2" "IndianRed2" "DarkOrange1"
              "PaleVioletRed2" "royal blue" "dark violet" "turquoise1"
              "gray29" "red1"))
  (defun jw-flip (i)
    (with-current-buffer "1"
      (let ((place (elt jw-place i)))
        (if place
            (progn
              (setf (buffer-substring place (+ place 1)) ".")
              (setf (elt jw-place i) nil))
          (let ((r -1))
            (while (< r 0)
              (let ((rr (+ 1 (random (+ 10 (* 40 10))))))
                (unless (save-excursion (goto-char rr) (eolp))
                  (setq r rr))))
            (setf (buffer-substring r (+ r 1)) "0") ;;(number-to-string i))
            (set-text-properties
             r (+ r 1) (list 'face (list ':background (elt jw-colors i))))
            (setf (elt jw-place i) r))))))    
  (dotimes (i 10)
    (setf (elt jw-timers i) (run-with-timer 0 (+ 0.1 (* (random 10) 0.1)) 'jw-flip i)))
  (pop-to-buffer "1"))
	
(dotimes (i 10)
  (cancel-timer (elt jw-timers i)))


Make pop3 mail download go faster on Windows.

There's a  program further down in  this file, for
downloading   email   on   pop3   in   emacs.   No
dependencies, works on Windows and linux the same,
I  use  it  every  day,  it's  good.  Except  that
downloading large attachments  goes crazy slow, in
Windows emacs. Like,  multiple minutes to download
a 5  mb file, that  bad. The longer it  takes, the
slower it seems to go. Or it'll even get stuck and
stop. And  some people  love to put  their message
into a 10  mb pdf instead of a  normal email. It's
kind of a pain.

Below is  a program that fixes  this pop3 slowness
in  Windows  emacs. It's  basically  a  copy of  a
program  from inside  pop3.el, but  with one  line
added by  me - the  (sit-for 1) near the  end. You
run this program below,  and that makes things way
way faster.   Add a  delay, to  make it  speed up.
Nuts, right?


(progn
  (require 'cl)
  (defun pop3-wait-for-messages (process count total-size start-point)
    (while (> count 0)
      (goto-char start-point)
      (while (or (and (re-search-forward "^\\+OK" nil t)
                      (or (not total-size)
                          (re-search-forward "^\\.\r?\n" nil t)))
                 (re-search-forward "^-ERR " nil t))
        (decf count)
        (setq start-point (point)))
      (unless (memq (process-status process) '(open run))
        (error "pop3 process died"))
      (when total-size
        (let ((size 0))
          (goto-char (point-min))
          (while (re-search-forward "^\\+OK.*\n" nil t)
            (setq size (+ size (- (point))
                          (if (re-search-forward "^\\.\r?\n" nil 'move)
                              (match-beginning 0)
                            (point)))))
          (message "pop3 retrieved %dKB (%d%%)"
                   (truncate (/ size 1000))
                   (truncate (* (/ (* size 1.0) total-size) 100)))))
      (discard-input) (sit-for 1) ;;; <<<------ MAKES THIS FAST IN WINDOWS EMACS                   
      (pop3-accept-process-output process))
    start-point))


Keep doing something again and again.

This one is  a sketch, an idea.  All  this does is
write a  character to a  file every 1  second, and
keep doing  that in  the background  forever while
you keep  using emacs. Which is  pretty useless on
its  own.  But  I  learned  recently that  writing
single chars  into certain  files is how  you turn
lights  on  and  off  in  those  fruit  pie  board
computers that people like  so much.  So here's me
pretending  to do  that.  And  because this  thing
keeps running  the in  the background, I  can keep
changing jw-loop  all I  like, C-M-x it,  and boom
it's set and running.

write-region and  set-buffer-modified-p seems like
a weird way  to save a file  in emacs. save-buffer
is the  usual way, I thought.  But write-region is
the fundamental low-level save  program, and so it
doesn't  have all  that  interactive messages  and
stuff  that  gets  weird in  a  background-running
situation like this. Probably way faster, too. Not
that I'm into that.


(defun jw-loop ()
  (sleep-for 1)
  (thread-yield)
  (save-excursion
    (set-buffer
     (find-file-noselect "~/file.txt" t t))
    (erase-buffer)
    (insert "a")
    (write-region nil nil buffer-file-name nil 'quiet)
    (set-buffer-modified-p nil)
    (kill-buffer)))

(setq jw-thread
			(make-thread
			 (lambda () (while t (funcall 'jw-loop)))))


Edit videos.

There's this  program ffmpeg which can  be used in
about  a  million  ways for  editing  videos.  But
figuring out  the commands  to do anything,  to me
it's like magic spells.  Anyways, about all I ever
need to  do is trim  pieces of video,  join pieces
together.  And so  I  figured out  the commands  I
needed,  and made  emacs programs  so I  could use
them  on files  I choose  in dired  (that's emacs'
built-in file directory browser.)

I go  into dired on  some directory with  my video
files. Then, I'll mark some files with m, and then
do a M-x jw-convert-to-mp4  on those, because some
of the  other things  seem to  work better  on mp4
files. Then I'll play the video with W, write down
the start  and end  times of the  stuff I  want to
keep.  Then  mark  that  file with  m,  do  a  M-x
jw-clip-video, and it'll ask  me for the start and
end time  and make the  clip. Do that a  few times
for the  bits I wanted.  And then I'll  rename the
clip files  with R, to have  1, 2, 3, in  front of
them - so  they sort out in the  right order. Then
I'll  do M-x  jw-join-videos,  to  join the  clips
together into  one file. Then maybe  mark that one
and do M-x jw-shrink-videos to make it smaller.

(defun jw-convert-to-mp4 ()
  "In dired, convert all marked files to mp4."
  (interactive)
  (mapcar
   (lambda(f)     
     (async-shell-command
      (format "ffmpeg -i %s -c:v libx264 -preset ultrafast %s.mp4" f f) f))
   (dired-get-marked-files t)))

(defun jw-clip-video (st ed)
  "While in dired, make a clip of the marked files between two times."
  (interactive "Mstart time in hh:mm:ss form: \nMend time in hh:mm:ss form : ")
  (let ((f (car (dired-get-marked-files t)))
        (ct (with-temp-buffer
              (insert st)
              (insert "--")
              (insert ed)
              (goto-char (point-min))
              (replace-string ":" "-")
              (buffer-string))))    
    (let ((cmd (format "ffmpeg -i %s -ss %s.0 -to %s.0 -codec copy clipped-%s-%s"
                       f st ed ct f)))
      (async-shell-command cmd))))

(defun jw-join-videos ()
  "While in dired, join the marked video files into one file: joined.mp4. Order inputs by their file names."
  (interactive)
  (let ((dir (dired-current-directory))
        (files (sort (dired-get-marked-files t) 'string<)))
    (with-temp-buffer   
      (dolist (f files)
        (insert (format "file '%s'" f))
        (newline))
      (write-file (format "%sjoinfiles.txt" dir) nil))
    (let ((cmd (format "ffmpeg -f concat -safe 0 -i joinfiles.txt -c copy joined.mp4")))
      (async-shell-command cmd))))

(defun jw-shrink-videos ()
	"Make a smaller version of the video files you have marked in dired."
  (interactive)
  (mapcar
   (lambda(f)     
     (async-shell-command
      (format "ffmpeg -i %s -s 320:240 -c:v libx264 -preset ultrafast sm-%s" f f) f))
   (dired-get-marked-files t)))


Speed up your emacs with this one weird trick.

Okay, first better  go rinse the puke  out of your
mouth after  reading that line .   And then please
continue,  because  it's  actually a  pretty  good
thing.

Maybe  this is  only for  people like  me who  run
emacs over  windows, not  sure.  But  without this
line,  my   emacs  would  get  really   slow  when
scrolling through  files with lots of  those funny
symbol characters  in them. You know,  the smileys
and   rocketships   and  fancy   bullet-dots   and
stuff. And my computer would draw each one as this
weird code-filled  box thingy. But I  run this one
line below, and it's  all sorted: the symbols show
up properly,  and there's  no more  slowness while
scrolling.

Some  gemini  people  sure do  like  those  symbol
characters.  I  guess those things draw  real good
on    all     their    arch-think-linux-pads    or
whatever.  But they  sure  bogged  me down,  until
now. Now I'm okay.

(set-fontset-font t 'symbol "Segoe UI Emoji")
;; see:  http://ergoemacs.org/emacs/emacs_list_and_set_font.html


Hook up my address book with my email.

My rmail+pop3  program is elsewhere in  this file,
and I still use it  every day. But I've added some
stuff since then. Like,  I went and installed this
"bbdb" package  which is like an  address book for
emacs, and it hooks up  real nice with emacs email
programs like  rmail and others. They're  made for
each other. All you got to do is a few commands to
set it up.

This  program  below  does a  pretty  usual  rmail
setup.   You'll   get  tab-completion   on   email
addresses  when   you  write  one,  and   it  will
automatically search  out all the  email addresses
when  you read  an email.  (Though I  disabled the
pop-up thing.) But  I added some stuff  so that it
only adds email addresses to bbdb when I press "C"
while reading mail. Because I don't want all those
donotreply@ things  in my  book, and I  don't like
that interactive prompting thing  that bbdb can do
for each email.

(progn
	(require 'bbdb)	
	(bbdb-initialize 'rmail)
	(bbdb-mua-auto-update-init 'rmail)
	(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)	
	(setq bbdb-update-records-p 'search)
	(setq bbdb-mua-pop-up nil)		
	(add-hook
	 'rmail-mode-hook
	 (lambda ()
		 (define-key rmail-mode-map "C"
			 (lambda () (interactive)
				 (bbdb-mua-display-all-records 'create)))
		 (define-key rmail-summary-mode-map "C"
			 (lambda () (interactive)
				 (bbdb-mua-display-all-records 'create))))))



Word processing.

This  program is  what  I run  before  I write  my
journals and  things. It  makes emacs act  sort of
like a word-processing program.   It just turns on
some modes and settings to  make my lines all even
like in this paragraph, and check my spelling as I
go. The whole paragraph-start business makes it so
that it  won't join together bulleted  or numbered
lists onto one line when it auto-fills, or if I do
a M-q.


(defun jw-wordprocessing ()
  "Setup for word processing: automatically fully-justify text to 50 columns,
except lines that look like they are a list item. Spell check as you type."
  (interactive)
  (let ((list-starting-chars
         (list "-" "+" "*" "#" "0-9"))
        (line-length 50))
    (setq-local paragraph-start
                (format
                 "^L\\|[ \t]*$\\|[ \t]*[%s]"
                 (seq-reduce 'concat
                             list-starting-chars "")))
    (setq default-justification 'full)
    (flyspell-mode)
    (set-fill-column line-length)
    (refill-mode)))


Print preview.

This one  is for  giving you a  rough idea  of how
your papers are  going to turn out  when you print
with  the jw-print  program. You  choose the  font
size and  it shows the  text in a  narrower buffer
according   to  that,   and  with   page  dividers
too.  Because it's  no  good when  you print  some
recipe in font size 14 and it prints half of it on
the next page or something. Or wraps everything in
a weird way.

I think the  table of rows and columns  I made for
each font size from 8 to 20 is a tiny bit off. But
whatever, close enough for recipes.

(defun jw-print-preview (point-size)
  (interactive "npoint size: ")
  (let* ((consolas-printing-sizes
          '((20 42 . 21) (19 44 . 22) (18 48 . 24)
            (17 50 . 25) (16 54 . 27) (15 56 . 29)
            (14 60 . 31) (13 66 . 34) (12 70 . 36) 
            (11 76 . 40) (10 84 . 44) (9  95 . 49)
            (8 105 . 55)))
         (cols-rows (cdr (assoc point-size consolas-printing-sizes))))
    (unless (consp cols-rows)
      (error "nothing for that point size."))
    (let ((width (car cols-rows))
          (lines (cdr cols-rows))
          (preview-buffer "*printpreview*"))
      (save-excursion
        (switch-to-buffer "*printpreview*")
        (setq buffer-read-only nil)
        (erase-buffer))
      (copy-to-buffer preview-buffer (point-min) (point-max))
      (switch-to-buffer preview-buffer)
      (set-text-properties (point-min) (point-max) nil)
      (save-excursion ;; delete all unicode characters
        (toggle-enable-multibyte-characters 0)    
        (goto-char (point-min))
        (while (< (point) (point-max))
          (if (> (char-after) #o177)
              (delete-char 1)
            (forward-char)))) 
      (set-window-margins nil 0 (- (window-width) width))
      (visual-line-mode 1)
      (let ((ol 0) (page 1))
        (goto-char (point-min))
        (while (not (equal (point) (point-max)))
          (beginning-of-visual-line)
          (end-of-visual-line)
          (forward-char)
          (setq ol (+ 1 ol))
          (when (equal 0 (mod ol lines))
            (beginning-of-visual-line)
            (insert (format "--%s" page))
            (setq page (+ page 1))
            (dotimes (c (- width 6)) (insert "-"))
            (newline)
            (setq ol 0))))
      (setq buffer-read-only t))))


Switch printers.

You  can  use this  one  to  choose which  Windows
printer you want to use.  It puts all the printers
your  computer  knows  about  into  one  of  those
auto-complete menus,  so then  you can type  it or
tab it or  arrow-key it in there.  This pairs well
with the previous print  program, which sends your
file  to the  default printer  without asking  you
first what that is.

It is good  to know what printer  you are printing
on. These second-hand office computers always have
a bunch  of old  printers still  listed. And  so I
think I accidentally  sent a bunch of  my stuff to
some insurance office halfway  across the world. I
hope they like gnocchi and meat loaf recipies.


(defun jw-set-printer ()
  "Choose Windows' default printer."
  (interactive)
  (shell-command
   (format
    "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n \"%s\""
    (let ((completion-ignore-case t)
          (history nil))
      (completing-read
       "printer: "
       (let (col1 col2 out)
				 (get-buffer-create "*printers*")
				 (switch-to-buffer "*printers*")
				 (erase-buffer)
         (toggle-truncate-lines 1)
         (shell-command "wmic printer list brief" "*printers*")
         (goto-char (point-min))
         (when (search-forward "Name" nil t)
           (backward-word)
           (setq col1 (point))
           (when (search-forward "PrinterState" nil t)
             (backward-word)
             (setq col2 (point))))
         (unless (and col1 col2)
           (error "could not find Name and PrinterState columns in wmic output"))
         (forward-line)
         (setq out nil)
         (while (> (length (thing-at-point 'line t)) 2)
           (move-beginning-of-line 1)
           (forward-char (- col1 1))
           (let ((txt (buffer-substring (point) (+ (point) (- col2 col1)))))
             (with-temp-buffer
               (insert txt)
               (goto-char (point-min))
               (delete-trailing-whitespace)
               (setq txt (buffer-string)))
             (setq out (cons txt out)))
           (next-line))
         out)
       nil t nil 'history)))))


Printing.

There's  a lot  of  recipes on  gopher  if you  go
looking, which  is pretty  great. You  know what's
not great?  Dropping your computer in  your pot of
soup   while  you're   trying   to  follow   those
recipes.  So when  I saw  some old  inkjet printer
laying  by the  side  of the  road,  I'm all  over
that. I dropped it on the way home and so the feed
tray is kind of busted, and  so is my knee, but it
still mostly works, and so does the printer.

Anyways,  emacs  printing  is not  so  great.   My
computer  has  windows  8.1  and  there's  no  lpr
command.  And  this ghost  script thing is  not so
good for me,  its only mono font is  courier. So I
made   this  program   to   print  stuff   through
write.exe.  write.exe  does the word  wrapping for
you if you're printing  gemini stuff with its long
lines, and for gopher choosing 11 as the font size
will give you 11 columns  and that's okay for most
stuff.

(defun jw-print (font-size)
  "Prints the current buffer to default printer."
  (interactive "nfont size: ")
  (unless (integerp font-size)
    (error "font size must be a number."))
  (let ((buffer (current-buffer))
        (tempfile "~/../../Desktop/Document2.rtf"))
    (with-temp-buffer
      (insert "{\\rtf1\\ansi\\ansicpg1252\\deff0\\nouicompat")
      (insert "\\deflang4105{\\fonttbl{\\f0\\fnil")
      (insert "\\fcharset0 Consolas;}}")
      (newline)
      (insert "{\\*\\generator Riched20 6.3.9600}\\viewkind4\\uc1")
      (newline)
      (insert
       (format
        "\\pard\\sa200\\sl276\\slmult1\\f0\\fs%s\\lang9"
        (* 2 font-size)))
      (newline)   
      (with-current-buffer (get-buffer-create "*rtf-working*")
        (insert-buffer-substring buffer)
        (untabify (point-min) (point-max))
        (goto-char (point-min))
        (set-text-properties (point-min) (point-max) nil)
        (save-excursion ;; delete all unicode characters
          (toggle-enable-multibyte-characters 0)    
          (goto-char (point-min))
          (while (< (point) (point-max))
            (if (> (char-after) #o177)
                (delete-char 1)
              (forward-char))))         
        (replace-regexp "$" "\\\\line"))
      (insert-buffer-substring "*rtf-working*")
      (kill-buffer "*rtf-working*")
      (insert "}")
      (newline)
      (write-file tempfile)
      (shell-command
       (format "write.exe /p \"%s\"" tempfile)))))


One note.

This  one  saves  a   single  note  into  a  sound
file. That's kind of a long ways off from making a
song, but it's a start.

(defun jw-tone-file (frequency duration volume)
  "Creates an AU file at ~/tone.au, with a single tone.
The .au file will be 8,000 Hz 8 bit PCM"
  (interactive 
    "sfrequency (Hz): \nsduration (seconds): \nsvolume (betweeen 0 and 1): ")
  (let* ((vol (string-to-number volume))
         (dur (string-to-number duration))
         (frq (string-to-number frequency))
         (samples '())
         (frame-rate 8000.0)
         (num-samples (* dur frame-rate)))
    (dotimes (f num-samples)
      (setq samples
            (cons
             (round (* 128 vol 1.0 
                       (sin (* 2 pi frq
                               (/ (- num-samples f)
                                  frame-rate)))))
             samples)))
    (let ((buffer (get-buffer-create "tone.au")))
      (with-current-buffer buffer
        (set-buffer-multibyte nil)
        (erase-buffer)
        (goto-char 1)
        (insert (string-as-unibyte "\x2E\x73\x6E\x64"))
        (insert (string-as-unibyte "\x00\x00\x00"))
        (insert (string-as-unibyte (byte-to-string 24)))
        (insert (string-as-unibyte "\xFF\xFF\xFF\xFF"))
        (insert (string-as-unibyte "\x00\x00\x00"))
        (insert (string-as-unibyte (byte-to-string 2)))
        (insert (string-as-unibyte "\x00\x00\x1F\x40"))
        (insert (string-as-unibyte "\x00\x00\x00\x01"))
        (dolist (s samples)
          (let ((b
                 (cond
                  ((> s 127) 127)
                  ((< s -127) -127)
                  ((and (>= s 0) (<= s 127)) s)
                  ((and (< s 0) (>= s -127)) (+ 256 s)))))
            (insert b)))
        (write-file "~/tone.au")
        (kill-buffer))))
  t)



Get stuff from youtube, slow.

I can  pick up the  wifi signal from  Cliff house,
and sometimes I use it to download stuff. But then
Cliff gets  all pissy because it  slows down their
tv shows and  his grandma gets pretty  angry. So I
made this program so I can slowly download youtube
videos with youtube-dl. That way I can skim just a
tiny  bit of  their internet  and they  don't even
notice.  It goes great with
gemini://pon.ix.tc/youtube.
Sure,  it takes  all day  for  me to  get like  10
minutes  of video,  but that's  okay, it  keeps me
from watching too  much. The "-r 5k"  is the magic
part.  You can  take that out, but  if you're like
me and mooch internet from your boss' grandma, you
should probably leave it in.

(defun jw-youtube-video (url name)
  (interactive "syoutube url: \nsname for file(s): ")
  (when (> (length url) 0)
    (let ((filename
           (if (> (length name) 0)
               (format " -o \"~/%s%%(playlist_index)s.mp4\"" name)
             "")))
      (async-shell-command
       (format
        "~/youtube-dl/youtube-dl %s -r 5k -f 18 \"%s\"" filename url)))))


Spelling toy.

I sort  of teach  grade one  kids on  Fridays, and
they  do have  some  old computer  in their  class
room.  And so  I made  this program  so they  have
something to do on it. I just run M-x jw-spelling,
C-x C-+ a bunch so  the text is really really big,
and leave it on for  whoever wants to try it. They
can type letters and numbers and the computer will
show  and say  what they  pressed. Enter  makes it
highlight and read out all the letters they typed,
and  then  the  whole word.  Spacebar  resets  the
program. Stickers  on those  keys helps  them find
them. Mostly the kids just mess around with making
nonsense  words. But  at  least they  get used  to
finding and recognizing letters. That's something,
right?

This thing  needs the "spd-say" program  to do the
talking, but  you could probably modify  it to use
something  else.  You'll  see  in there  I got  it
working with Windows too using another thing.

(defun jw-spelling ()
  "spelling"
  (interactive)
  (defvar jw-spell-overlay1)
  (defvar jw-spell-letter-wait 0.5)
  (defvar jw-spell-word-wait 1.0)
  (defun jw-spell-say-key ()
    (interactive)
    (when (<= (point-max) 10)
      (let ((buffer-read-only nil))
        (insert (this-command-keys)) (redisplay)
        (jw-spell-say (this-command-keys)))))
  (defun jw-spell-reset ()
    (interactive)
    (let ((buffer-read-only nil)) (erase-buffer)))
  (defun jw-spell-go ()
    (interactive)
    (when (> (point-max) (point-min))
      (let ((o jw-spell-overlay1)
            (beg (point-min))
            (end (point-max)))
        (move-overlay o 1 1) (redisplay)
        (dotimes (i (- end beg))
          (let ((pos (+ beg i)))
            (move-overlay o pos (+ pos 1)) (redisplay)
            (jw-spell-say (buffer-substring pos (+ pos 1)))
            (jw-spell-wait jw-spell-letter-wait)))      
        (move-overlay o beg end)(redisplay)
        (jw-spell-say (buffer-substring beg end))
        (jw-spell-wait jw-spell-word-wait)
        (move-overlay o 1 1) (redisplay))))
  (defun jw-spell-say (s)
    (if (equal system-type 'windows-nt)
        (shell-command (format "wscript c:\\users\\argra_000\\Documents\\say2.vbs %s" s))
    (shell-command (format "spd-say -t female3 -w %s" s))))
  (defun jw-spell-wait (w) (sit-for w) (discard-input))
  (define-derived-mode jw-spell-mode
    special-mode "jw-spell"
    "Special mode for spelling."
    (setq cursor-type nil)
    (setq jw-spell-overlay1 (make-overlay 1 1))
    (overlay-put
     jw-spell-overlay1
     'face '(:foreground "black" :background "yellow" ))
    (jw-spell-reset))
  (setq jw-spell-mode-map
        (let ((map (make-sparse-keymap)))
          (define-key map " " 'jw-spell-reset)
          (define-key map (kbd "RET") 'jw-spell-go)
          (dolist (c (append (number-sequence ?a ?z) (number-sequence ?0 ?9)))
            (define-key map
              (make-string 1 c) 'jw-spell-say-key))
          map))
  (switch-to-buffer "*jw-spell*")
  (jw-spell-mode))

say2.vbs:

Set objVoice = CreateObject("SAPI.SpVoice")  
If(WScript.Arguments.Count=1) Then
  s=WScript.Arguments.item(0)
Else
  s="no"
End If
objVoice.Speak s 




elpher that does word wrap.

This is a modified version of elpher.el. Elpher is
a gopher and gemini reader.  I added a new command
"w" that  switches it between doing  word wrap, or
clipping to some fixed  line length. Clipping to a
fixed  length is  what regular  elpher has  always
done. But  word wrap  sure works  a lot  nicer for
gemini  if you  sometimes like  to make  your text
size bigger with C-x C-+  like I do. And also this
version does  not reset  the text size  with every
page load like regular elpher does.

elpher.el with my modifications:
gopher://republic.circumlunar.space/0/~joneworlds/elpher.el

Regular elpher:
gopher://thelambdalab.xyz/1/projects/elpher/



Draw some trees.

They  say planting  trees  will  help offset  your
carbon  footprint.   This  program  will   not  do
that.  But it  does  print out  a  nice forest  of
trees.  I  sure love  trees.  As  for reducing  my
footprint, I  always remember to wipe  my shoes on
the doormat before coming in. Seems to help.

(defun jw-trees ()
  "Draws some trees."
  (interactive)
  (defun jw-coords-insert (str x y)
    (when (and (<= x xmax) (<= y ymax)
               (> x 0) (> y 0))
      (let ((p (+ x (- y 1) (* xmax (- y 1)))))
        (goto-char p)
        (delete-char 1)
        (insert str))))
  (defface jw-tree-leaves '((t ())) "tree leaves" :group 'jw-trees)
  (face-spec-set
   'jw-tree-leaves '((t (:foreground "green"))))
  (set-face-bold 'jw-tree-leaves t)
  (defface jw-tree-dirt '((t ())) "tree dirt" :group 'jw-trees)
  (face-spec-set
   'jw-tree-dirt '((t (:foreground "DarkSeaGreen4"))))  
  (defface jw-tree-trunks '((t ())) "tree trunks" :group 'jw-trees)
  (face-spec-set
   'jw-tree-trunks '((t (:foreground "sienna4"))))
  (set-face-bold 'jw-tree-trunks t) 
  (let ((xmax 55) (ymax 15)
        (density 0.1)
        (min-height 2) (max-height 3)
        (forest-floor ?`)
        (trunk ?|) (boughs ?^))
    (pop-to-buffer "*trees*")
    (delete-other-windows)
    (erase-buffer)
    (dotimes (i ymax)
      (dotimes (j xmax) (insert (elt '("." "`" ",") (random 3))))
      (newline))
    (let ((trees nil))
      (dotimes (i (floor (* density xmax ymax)))
        (setq trees (cons (cons (random xmax) (random ymax)) trees)))
      (dolist (tr trees)
        (jw-coords-insert trunk (car tr) (cdr tr))
        (let ((bough (elt '(?^ ?# ?^ ?^ ?v ?@) (random 6))))
          (dotimes (h (+ min-height (random (- max-height min-height))))
            (jw-coords-insert bough (car tr) (- (cdr tr) (+ h 1))))))))
  (dolist
      (p '((jw-tree-dirt . "\\.")
           (jw-tree-dirt . "`")
           (jw-tree-dirt . ",")                        
           (jw-tree-leaves . "\\^")
           (jw-tree-leaves . "#")
           (jw-tree-leaves . "v")
           (jw-tree-leaves . "@")          
           (jw-tree-trunks . "|")
           (jw-tree-trunks . "I")))
    (unhighlight-regexp (cdr p))
    (highlight-regexp (cdr p) (car p))))



Get my mail.

There's sure some complicated chains of programs I
seen people  do to pick  up and send  mail through
emacs. Maybe  they get more  email than me,  but I
don't need that stuff. This  program here is all I
do for  mail. No extra  parts needed, and  it even
works  the  same  on windows  and  unix  computers
too. C-u  C-x jw-movemail  goes and gets  it, then
M-x  rmail for  reading  it. You  got  your h  for
listing it,  r for  replying, o  for saving  it to
other files, i for switching to those, d and q for
deleting, and  C-x m for  writing a new  one. Good
enough.

(progn
  (setq
   user-mail-address "joneworlds@mailbox.org"
   user-full-name "Jone"
   smtpmail-smtp-server "smtp.mailbox.org"
   smtpmail-smtp-service 465
   smtpmail-stream-type 'ssl
   smtpmail-default-smtp-server "smtp.mailbox.org"
   send-mail-function 'smtpmail-send-it)
  (add-hook 'message-setup-hook
            (lambda()(interactive)
              (message-goto-fcc)
              (insert "~/Sent.mbox")))
  (require 'pop3)
  (defun jw-movemail (arg)
    (interactive "P")
    (setq rmail-movemail-program nil)
    (setq rmail-primary-inbox-list nil)
    (setq rmail-file-name "~/RMAIL")
    (if (and
         arg
         (file-exists-p rmail-file-name)
         (> (elt (file-attributes rmail-file-name) 7) 1))
        (message "Won't continue, %s still has mail in it."
          rmail-file-name)
      (progn  
        (delete-file pop3-uidl-file)
        (let
            ((pop3-maildrop "joneworlds@mailbox.org")
             (pop3-mailhost "pop3.mailbox.org")
             (pop3-password nil)
             (pop3-leave-mail-on-server
              (if arg nil t))
             (pop3-debug nil)
             (pop3-password-required t))
          (pop3-movemail "~/RMAIL"))))))


Shuffling lines.

You know sometimes  how you have a  list of things
to do, but  you don't much care what  order you do
them  in? No?  Well  okay, maybe  you  are a  more
organized and intentional person than I am. But if
you're  like me,  now  with this  program you  can
easily jumble  up your  to-do list and  enjoy your
poorly-planned  day. Which  is great.  Except that
time when it put breakfast lunch and dinner all at
the  end  of  the  list.  I  really  didn't  enjoy
that.  So maybe  there's still  some bugs  to work
out.

(defun jw-shuffle-lines (start end)
  "Shuffles the lines in the marked region."
  (interactive "r") 
  ;; Move the selected lines to a temporary buffer. Put a random
  ;; number at the beginning of each line, sort the lines, and then
  ;; remove the random numbers. Insert the jumbled lines back into the
  ;; original buffer.
  (let ((lines (buffer-substring start end)))
    (kill-region start end)
    (insert
     (with-temp-buffer
       (insert lines)
       (goto-char (point-min))
       (while (re-search-forward "^" nil t)
         (move-beginning-of-line 1)
         (insert (number-to-string (random 1000000)))
         (insert "#"))
       (sort-lines nil (point-min) (point-max))
       (goto-char (point-min))
       (while (re-search-forward "^[0-9]+#" nil t)
         (goto-char (match-beginning 0))
         (replace-match ""))
       (buffer-string)))))


Random letters.

This  one  inserts  a   random  letter  into  your
file. This is useful if  you need to, uh, insert a
random letter into your file.

(defun jw-put-random-letter ()
  "Replace character at point with a random letter. Then move two to the right."
  (interactive)
  (insert (char-to-string (+ (random 26) ?a)))
  (if (not (equal (char-after) 10))
      (progn
        (delete-char 1)
        (forward-char 1))
    (progn
      (insert " "))))
(global-set-key (kbd "C-c ,") 'jw-put-random-letter)