Here is a small collection of (mostly) my hacks. Some of which are
even useful.
-dired-tar.el -- Handle tarballs in Dired. Updated to support
- bzip2, lzma, and xz.
-ffi-mpd.el -- non-working
-ges-post.el -- Ease sending lisp to gnu.emacs.sources
-google-query.el -- Search Google from within (S)XEmacs
-linux-kernel.el -- Check the lastest Linux kernel release
-lj.el -- Post entries to a LiveJournal blog
-mpd.el -- Control mpd (Music Player Daemon
- http://www.musicpd.org) from SXEmacs.
-mozmail.el -- Compose mail in a emacs MUA from mailto links in
- Mozilla
-patch-keywords.el -- An aid for XEmacs patch reviewers
-pkg-build.el -- Automate the drudgery of the XEmacs Packages
- Release Manager
-pui-update.el -- Update XEmacs packages from cron (non-working)
-sxell.el -- SXEmacs interface to the Emacs Lisp List
-snap.el -- An updated version of snap.el (from the howm
- guy). This one supports (S)XEmacs.
+ dired-tar.el -- Handle tarballs in Dired. Updated to support
+ bzip2, lzma, and xz.
+ ffi-mpd.el -- non-working
+footnote-balloons.el -- Display footnotes in a balloon-help frame.
+ ges-post.el -- Ease sending lisp to gnu.emacs.sources
+ google-query.el -- Search Google from within (S)XEmacs
+ linux-kernel.el -- Check the lastest Linux kernel release
+ lj.el -- Post entries to a LiveJournal blog
+ mpd.el -- Control mpd (Music Player Daemon
+ http://www.musicpd.org) from SXEmacs.
+ mozmail.el -- Compose mail in a emacs MUA from mailto links in
+ Mozilla
+ patch-keywords.el -- An aid for XEmacs patch reviewers
+ pkg-build.el -- Automate the drudgery of the XEmacs Packages
+ Release Manager
+ pui-update.el -- Update XEmacs packages from cron (non-working)
+ sxell.el -- SXEmacs interface to the Emacs Lisp List
+ snap.el -- An updated version of snap.el (from the howm
+ guy). This one supports (S)XEmacs.
Installation:
--- /dev/null
+;; footnote-balloons.el --- Show footnotes in balloon-help frame -*- Emacs-Lisp -*-
+
+;; Copyright (C) 2012 Steve Youngs
+
+;; Author: Steve Youngs <steve@sxemacs.org>
+;; Maintainer: Steve Youngs <steve@sxemacs.org>
+;; Created: <2012-01-27>
+;; Time-stamp: <Tuesday Mar 25, 2014 10:38:13 steve>
+;; Homepage: http://www.xemacs.org
+;; Keywords: mail, news, text, footnote
+
+;; This file is part of XEmacs.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+;;
+;; 3. Neither the name of the author nor the names of any contributors
+;; may be used to endorse or promote products derived from this
+;; software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
+;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; Commentary:
+;;
+;;
+
+;;; Todo:
+;;
+;;
+
+;;; Code:
+(require 'footnote)
+(require 'balloon-help)
+
+
+(defvar footnote-balloon-regexp "\\[[^\]\n]+\\]")
+
+(defun get-foot-string ()
+ (let (b ext)
+ (while (looking-at "[ \t]")
+ (forward-char))
+ (setq b (point))
+ ;; Find the end of the footnote.
+ (re-search-forward (concat "\\\n\\\n\\|\\'\\|"
+ footnote-balloon-regexp) nil t)
+ (beginning-of-line)
+ (while (looking-at "^")
+ (backward-char))
+ (setq ext (make-extent b (point)))
+ (set-extent-property ext 'footnote t)
+ (set-extent-face ext 'green)
+ (extent-string ext)))
+
+(defun footnote-balloons ()
+ "Turn footnote refs into extents containing the fn string as balloon-help."
+ (interactive)
+ (map-extents
+ #'(lambda (extent ignore)
+ (when (extent-property extent 'footnote)
+ (delete-extent extent))))
+ (save-excursion
+ (let (ref-beg ref-end ext footnum note)
+ (goto-char (point-min))
+ ;; Looking for footnote refs in the text.
+ (while (re-search-forward footnote-balloon-regexp nil t)
+ (setq ref-beg (match-beginning 0))
+ (setq ref-end (match-end 0))
+ (setq footnum (buffer-substring ref-beg ref-end))
+ (goto-char (point-max))
+ ;; Now find the footnote itself.
+ (when (search-backward footnum ref-end t)
+ (search-forward footnum nil t)
+ (setq note (get-foot-string))
+ (setq ext (make-extent ref-beg ref-end))
+ (set-extent-face ext 'red)
+ (set-extent-property ext 'footnote t)
+ (set-extent-property ext 'highlight t)
+ (set-extent-property ext 'balloon-help note))
+ (goto-char ref-end)))))
+
+(provide 'footnote-balloons)
+;;; footnote-balloons.el ends here
;;
;;; Code:
-(defconst google-query-version 1.9
+(defconst google-query-version 2.0
"Version number of google-query.el.")
(defun google-query-version (&optional arg)
:prefix "google-"
:group 'hypermedia)
-(defcustom google-query-maxlen 100
+(defcustom google-query-maxlen 1024
"Maximum string length of query string.
This prevents you from accidentally sending a five megabyte query
:type 'number
:group 'google)
-(defcustom google-query-mirror "www.google.com"
- "*Your favourite Google mirror.
-
-Omit the \"http://\" part, all we want here is a domain."
+(defcustom google-query-mirror "https://www.google.com"
+ "*Your favourite Google mirror."
:type 'string
:group 'google)
-(defcustom google-query-debug nil
- "When non-nil keep the process buffer around."
- :type 'boolean
- :group 'google)
-
(defun google-query-commentary ()
"*Display the commentary section of google-query.el."
(interactive)
(buffer-string (current-buffer)))))
"*Google-query Copyright Notice*"))
-;; Ripped from thingatpt.el
-(defconst google-query-url-regexp
- (concat
- "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)"
- "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+")
- "A regular expression matching URLs.")
-
-(defun google-query-url-at-point ()
- "Browse to a URL from the google-query buffer."
- (interactive)
- (when (extentp (extent-at (point)))
- (browse-url (extent-string (extent-at (point))))))
-
-(defun google-query-url-at-mouse (event)
- "Browse to a URL at EVENT via the mouse from the google-query buffer."
- (interactive "e")
- (when (extentp (extent-at-event event))
- (browse-url (extent-string (extent-at-event event)))))
-
-(defun google-query-kill-buffer ()
- (interactive)
- (kill-buffer nil))
-
-(defconst google-query-mode-map
- (let* ((map (make-sparse-keymap 'google-query-mode-map)))
- (define-key map [space] 'scroll-up)
- (define-key map [delete] 'scroll-down)
- (define-key map [q] 'bury-buffer)
- (define-key map [Q] 'google-query-kill-buffer)
- map)
- "A keymap for the google query buffer.")
-
-(defconst google-query-ext-map
- (let* ((map (make-sparse-keymap 'google-query-ext-map)))
- (define-key map [button2] 'google-query-url-at-mouse)
- (define-key map [return] 'google-query-url-at-point)
- map)
- "A keymap for the extents in google query results buffer.")
-
;; Unashamedly stolen from Bill Perry's URL package.
(defconst google-query-unreserved-chars
'(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
(char-to-string char)))
str ""))
-(defun google-query-make-url-extents ()
- "Create extent objects for all the URLs in the buffer."
- (goto-char (point-min))
- (save-excursion
- (while (re-search-forward google-query-url-regexp nil t)
- (let ((extent (make-extent (match-beginning 0) (match-end 0)))
- (echo "RET or Button2 to visit this URL."))
- (set-extent-property extent 'face 'bold)
- (set-extent-property extent 'mouse-face 'highlight)
- (set-extent-property extent 'keymap google-query-ext-map)
- (set-extent-property extent 'help-echo echo)
- (set-extent-property extent 'balloon-help echo)
- (set-extent-property extent 'duplicable t)))))
-
-(defun google-query-mode ()
- "Major mode for google-query results buffer.
-\\{google-query-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map google-query-mode-map)
- (setq mode-name "Google")
- (setq major-mode 'google-query-mode))
-
-(defun google-query-process-results (results)
- "Process the RESULTS of `google-query'."
- (let ((buf (get-buffer-create "*google-query-results*"))
- matches
- titles)
- (switch-to-buffer buf)
- (google-query-mode)
- (erase-buffer)
- (insert results)
- ;; Collect the stuff we want.
- (goto-char (point-max))
- (while (re-search-backward "<a href=\"\\(.*\\)\" class=l>\\(.*\\)</a>" nil t)
- (setq matches (push (match-string 1) matches)
- titles (push (match-string 2) titles)))
- ;; Replace the contents of the buffer with our matches.
- (erase-buffer)
- (insert "Google Query Results\n====================\n\n")
- (while matches
- (insert (car titles) "\n" (car matches))
- (insert "\n\n")
- (setq titles (cdr titles)
- matches (cdr matches)))
- (goto-char (point-min))
- (center-line 2)
- (mapcar
- #'(lambda (x) (save-excursion (eval x)))
- '((replace-string "<b>" " ")
- (replace-string "</b>" "")
- (replace-regexp "<.*>" " ")
- (replace-string ">" " ")))
- (save-excursion
- (fill-region (point) (point-max)))
- (google-query-make-url-extents)))
-
;;;###autoload
(defun google-query (string)
"Query google for STRING."
(interactive "sQuery Google for: ")
(let* ((host google-query-mirror)
- (user-agent (concat (if (featurep 'sxemacs)
- "SXEmacs-"
- "XEmacs-")
- emacs-program-version))
(str (google-query-hexify-string
(truncate-string-to-width string google-query-maxlen)))
- (query (concat "search?&q=" str
- "&num=" (format "%d" google-query-result-count)))
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (google (open-network-stream
- "google-query"
- " *google-query-proc*"
- host
- 80))
- (pbuf (process-buffer google)))
- (process-send-string
- google
- (concat "GET /" query " HTTP/1.1\r\n"
- "MIME-Version: 1.0\r\n"
- "Connection: close\r\n"
- "Host: " host "\r\n"
- "Accept: */*\r\n"
- "User-Agent: " user-agent "\r\n\r\n"))
- (message "Talking to Google, please wait...")
- (while (eq (process-status google) 'open)
- (sleep-for 0.05))
- (google-query-process-results (buffer-string pbuf))
- (unless google-query-debug
- (kill-buffer pbuf))))
+ (query (concat "/search?&q=" str
+ "&num=" (format "%d" google-query-result-count))))
+ (browse-url (concat host query))))
;;;###autoload
(defun google-query-region (beg end)
;; Author: Steve Youngs <sryoungs@bigpond.net.au>
;; Maintainer: Steve Youngs <sryoungs@bigpond.net.au>
;; Created: <2003-12-15>
-;; Last-Modified: <2003-12-15 08:38:58 (steve)>
+;; Last-Modified: <2014-03-25 18:04:25 (steve)>
;; Homepage: None
;; Keywords: kernel linux
(defun linux-kernel-check-latest ()
"Display a list of the latest kernel versions."
(interactive)
- (let* ((host "www.kernel.org")
- (dir "/kdist/")
- (file "finger_banner")
- (path (concat dir file))
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (user-agent (concat "XEmacs " emacs-program-version))
- (http
- (open-network-stream
- "latest-kernel-proc"
- " *kernel-proc-buf*"
- host
- 80))
- (pbuf (process-buffer http))
- (obuf (get-buffer-create "*Latest Kernels*")))
- (process-send-string
- http
- (concat "GET " path " HTTP/1.1\r\n"
- "MIME-Version: 1.0\r\n"
- "Connection: close\r\n"
- "Extension: Security/Digest Security/SSL\r\n"
- "Host: " host "\r\n"
- "Accept: */*\r\n"
- "User-Agent: " user-agent "\r\n\r\n"))
- (working-status-forms "Checking Kernel Version: " "Done!"
- (while (eq (process-status http) 'open)
- (working-dynamic-status nil)
- (sleep-for 0.05))
- (working-dynamic-status t))
+ (let ((finger_banner (expand-file-name "finger_banner" (temp-directory)))
+ (obuf (get-buffer-create "*Linux Kernels*")))
+ (curl:download "https://www.kernel.org/finger_banner"
+ finger_banner)
(with-electric-help
- '(lambda ()
- (insert
- (with-current-buffer pbuf
- (goto-char (point-min))
- (while (re-search-forward "\r" nil t) nil)
- (kill-region (point-min) (point))
- (insert "The Latest Linux Kernels\n========================\n\n")
- (goto-char (point-min))
- (center-line 2)
- (re-search-forward "^Process.*$" nil t)
- (replace-match "")
- (buffer-string (current-buffer)))))
- obuf)
- (kill-buffer pbuf)))
+ #'(lambda ()
+ (insert "The Latest Linux Kernels\n========================\n\n")
+ (goto-char (point-min))
+ (center-line 2)
+ (insert-file-contents finger_banner)
+ (delete-file finger_banner)
+ (buffer-string (current-buffer)))
+ obuf)))
(provide 'linux-kernel)
;;; linux-kernel.el ends here
;; lj.el --- LiveJournal meets SXEmacs -*- Emacs-Lisp -*-
-;; Copyright (C) 2008 - 2011 Steve Youngs
+;; Copyright (C) 2008 - 2014 Steve Youngs
;; Author: Steve Youngs <steve@sxemacs.org>
;; Maintainer: Steve Youngs <steve@sxemacs.org>
;; plus the first letter or two of the next tag you wanna use
;; after the last inserted tag.
;;
-;;; Twitter: (broken, don't use)
-;;
-;; This is currently broken because twitter turned off Basic Auth
-;;
-;; You can optionally post the subject header of your blog entry as
-;; a status update to Twitter, along with a URL to the entry on
-;; livejournal.com. To do so, you must set...
-;;
-;; `lj-twitter-flag'
-;; `lj-twitter-username'
-;; `lj-twitter-password'
-;;
-;; The down side to this is that your twitter username and password
-;; are stored in clear text. I'll work on a way to make that safer
-;; later.
-;;
;; Have fun with it!
;;; Todo:
;; choose different qotd's after one has been selected. Also, be
;; able to view older qotd's.
;;
-;; o Rewrite the twitter code to use OAuth.
;;
;;; Bugs:
;;
;;; Version:
-(defconst lj-version 1.30
+(defconst lj-version 1.31
"Version number of SXEmacs/LJ.")
;;; Code:
:link '(url-link "http://www.livejournal.com/")
:group 'hypermedia)
-(defgroup lj-twitter nil
- "LiveJournal meets Twitter"
- :prefix "lj-twitter-"
- :link '(url-link "http://www.livejournal.com/")
- :link '(url-link "http://twitter.com/")
- :group 'lj)
-
(defun lj-customise-faces ()
"Customise the lj.el faces."
(interactive)
"The default LJ userpic keyword.")
;; See mpd.el in the same repo as lj.el
-(defvar **mpd-var-Title* nil)
-(defvar **mpd-var-Artist* nil)
-(defun lj-music-mpd ()
- "Return the current song title/artist from mpd."
- (let ((song (if **mpd-var-Title*
- (format "%s --- [%s]"
- **mpd-var-Title*
- **mpd-var-Artist*)
- "The Sounds of Silence --- [Marcel Marceau]")))
- song))
-
-(defcustom lj-music (and (featurep 'mpd) #'lj-music-mpd)
+(defcustom lj-music (and (featurep 'mpd) #'mpd-now-playing)
"*A function to retrieve current song for LJ music header.
This function should return a formatted string, or nil."
:type 'function
:type 'hook
:group 'lj)
-(defcustom lj-twitter-flag nil
- "*Non-nil means to update your twitter status.
-
-The subject header and a URL to the last blog entry is posted to
-twitter as a status update if this is set."
- :type 'boolean
- :group 'lj-twitter)
-
-(defcustom lj-twitter-username (user-login-name)
- "*Your twitter username."
- :type 'string
- :group 'lj-twitter)
-
-;;; FIXME: Can we store this in something OTHER than plain text. Do
-;;; we even need it at all with OAuth?
-(defcustom lj-twitter-password "secret"
- "*Your twitter password."
- :type 'string
- :group 'lj-twitter)
-
(defconst lj-clientversion
(concat (when (featurep 'sxemacs) "S")
"XEmacs-"
(btime (apply #'encode-btime (lj-parse-time-string timestr))))
(btime-to-time btime)))
-(defun lj-twitter-compress-url (url)
+(defun lj-compress-url (url)
"Compress URL using tinyurl.com."
(with-temp-buffer
(mm-url-insert
(lj-hexify-string url t)))
(buffer-string)))
-(defun lj-twitter-sentinel (process status)
- "Sentinel for `lj-twitter-update-status' PROCESS STATUS."
- (if (equal status "finished\n")
- (message "Sending to Twitter...done")
- (message "Sending to Twitter...failed: %s"
- (substring status 0 (1- (length status))))))
-
-;;; FIXME: Twitter no longer supports Basic Auth, so must rewrite this
-;;; using OAuth.
-(defun lj-twitter-update-status (user pass status url)
- "Update twitter status.
-
-Argument USER is your twitter username.
-Argument PASS is your twitter password.
-Argument STATUS is the subject header from your LJ post.
-Argument URL is the URL to the post on livejournal.com."
- (let* ((userpass (format "%s:%s" user pass))
- (turl (lj-twitter-compress-url url))
- (twit (concat "status="
- (lj-hexify-string
- (concat status " See: " turl) t)))
- (twiturl "http://twitter.com/statuses/update.json")
- proc)
- (if (<= (length twit) 147) ; twitter's max + "status="
- (progn
- (setq proc
- (apply #'start-process
- "LJcurl" nil "curl"
- (list "-u" userpass
- "-d" twit
- "-s" twiturl
- "-H" "X-Twitter-Client: SXEmacs_LJ"
- "-H" (format "X-Twitter-Client-Version: %s"
- lj-version)
- "-H" (concat
- "X-Twitter-Client-URL: "
- "http://www.sxemacs.org/~steve/lj/lj.xml")
- "-d" "source=lj.el")))
- (set-process-sentinel proc #'lj-twitter-sentinel))
- (warn "LJ subject too long for Twitter"))))
-
(defun lj-check-limits (bodlen sublen taglen muslen loclen)
"Make sure we don't exceed any LJ size limits.
(lj-archive-post (lj-header-content "fcc")))
(and lj-bcc-address
(lj-send-bcc subject security tags comm mood music location body))
-;;; FIXME: twitter updates are broken, needs OAuth
-;; (and lj-twitter-flag
-;; (lj-twitter-update-status lj-twitter-username lj-twitter-password
-;; subject lj-last-url))
;; If there is a itemid don't delete the draft because it is our
;; archive copy
(when (zerop (length itemid))
projects / slh / commitdiff