From d67adee95f28bef3f21df83e2086db7d49b3338b Mon Sep 17 00:00:00 2001 From: Steve Youngs Date: Tue, 25 Mar 2014 21:43:19 +1000 Subject: [PATCH] Updates to google-query.el, linux-kernel.el, and lj.el New Addition: footnote-balloons.el. Display footnotes in balloon-help frames. google-query.el was made a lot simpler and more impervious to changes in the way google displays results by simply calling browse-url instead of trying to do raw HTTP in-house. linux-kernel.el works again. Removed all of the twitter stuff from lj.el * footnote-balloons.el: New. * README: Mention footnote-balloons.el * google-query.el (google-query): Complete refactoring. Instead of trying to do it all "in-house" with #'open-network-stream and parsing process buffers, simply call #'browse-url on it. (google-query-process-results): Removed. (google-query-mode): Removed. (google-query-make-url-extents): Removed. (google-query-ext-map): Removed. (google-query-mode-map): Removed. (google-query-kill-buffer): Removed. (google-query-url-at-mouse): Removed. (google-query-url-at-point): Removed. (google-query-url-regexp): Removed. (google-query-debug): Removed. (google-query-mirror): Default to "https://www.google.com". (google-query-maxlen): Bump default to 1024. (google-query-version): Bump to 2.0 * linux-kernel.el (linux-kernel-check-latest): Retrieve the info via #'curl:download. * lj.el (lj-music-mpd): Removed. (lj-music): Use #'mpd-now-playing (lj-twitter): Removed. (lj-twitter-flag): Removed. (lj-twitter-username): Removed. (lj-twitter-password): Removed. (lj-twitter-compress-url): Renamed to lj-compress-url. (lj-twitter-sentinel): Removed. (lj-twitter-update-status): Removed. Signed-off-by: Steve Youngs --- README | 37 +++++------ footnote-balloons.el | 100 ++++++++++++++++++++++++++++++ google-query.el | 142 +++---------------------------------------- linux-kernel.el | 57 ++++------------- lj.el | 108 ++------------------------------ 5 files changed, 143 insertions(+), 301 deletions(-) create mode 100644 footnote-balloons.el diff --git a/README b/README index 1b33c8c..80821df 100644 --- a/README +++ b/README @@ -3,24 +3,25 @@ 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: diff --git a/footnote-balloons.el b/footnote-balloons.el new file mode 100644 index 0000000..59e5e48 --- /dev/null +++ b/footnote-balloons.el @@ -0,0 +1,100 @@ +;; footnote-balloons.el --- Show footnotes in balloon-help frame -*- Emacs-Lisp -*- + +;; Copyright (C) 2012 Steve Youngs + +;; Author: Steve Youngs +;; Maintainer: Steve Youngs +;; Created: <2012-01-27> +;; Time-stamp: +;; 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 diff --git a/google-query.el b/google-query.el index e164191..d8ffd42 100644 --- a/google-query.el +++ b/google-query.el @@ -78,7 +78,7 @@ ;; ;;; 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) @@ -103,7 +103,7 @@ buffer." :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 @@ -119,18 +119,11 @@ length that Google can take is 2048 characters." :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) @@ -164,45 +157,6 @@ Omit the \"http://\" part, all we want here is a domain." (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 @@ -227,98 +181,16 @@ This is taken from RFC 2396.") (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 "\\(.*\\)" 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 "" " ") - (replace-string "" "") - (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) diff --git a/linux-kernel.el b/linux-kernel.el index 370aa25..9897b34 100644 --- a/linux-kernel.el +++ b/linux-kernel.el @@ -6,7 +6,7 @@ ;; Author: Steve Youngs ;; Maintainer: Steve Youngs ;; 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 @@ -118,50 +118,19 @@ (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 diff --git a/lj.el b/lj.el index 6ab5286..8994d04 100644 --- a/lj.el +++ b/lj.el @@ -1,6 +1,6 @@ ;; lj.el --- LiveJournal meets SXEmacs -*- Emacs-Lisp -*- -;; Copyright (C) 2008 - 2011 Steve Youngs +;; Copyright (C) 2008 - 2014 Steve Youngs ;; Author: Steve Youngs ;; Maintainer: Steve Youngs @@ -114,22 +114,6 @@ ;; 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: @@ -138,7 +122,6 @@ ;; 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: @@ -150,7 +133,7 @@ ;; ;;; Version: -(defconst lj-version 1.30 +(defconst lj-version 1.31 "Version number of SXEmacs/LJ.") ;;; Code: @@ -191,13 +174,6 @@ :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) @@ -312,18 +288,7 @@ XHTML 1.0 Transitional if you plan to validate before posting." "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 @@ -407,26 +372,6 @@ Set to nil to disable." :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-" @@ -2625,7 +2570,7 @@ The value returned is that same as from `encode-time'." (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 @@ -2633,47 +2578,6 @@ The value returned is that same as from `encode-time'." (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. @@ -2763,10 +2667,6 @@ With two prefix args, also set a \"date out of order\" flag." (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)) -- 2.25.1