From 1b0abee054235ea4ac7589dd92d3939e1386d24a Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 12 Oct 2010 23:39:29 +0200 Subject: Initial contents --- net/jao-frm.el | 214 ++++++++++++++++++++++++++ net/jao-w3m-session.el | 410 +++++++++++++++++++++++++++++++++++++++++++++++++ net/jao-weather.el | 219 ++++++++++++++++++++++++++ 3 files changed, 843 insertions(+) create mode 100644 net/jao-frm.el create mode 100644 net/jao-w3m-session.el create mode 100644 net/jao-weather.el (limited to 'net') diff --git a/net/jao-frm.el b/net/jao-frm.el new file mode 100644 index 0000000..1635f00 --- /dev/null +++ b/net/jao-frm.el @@ -0,0 +1,214 @@ +;;; jao-frm.el --- use frm to show mailbox + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: mail + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Little hack to see the contents of your mailbox using GNU mailutils' +;; `frm' program. +;; +;; Just put (require 'jao-frm) in your .emacs, and M-x jao-frm will pop up a +;; new window with your mailbox contents (from and subject) as +;; printed by frm. In this buffer, use `n' and `p' to move, `q' to close +;; the window. `g' will call Gnus. +;; + +;;; Code: + +;;;; Customisation: + +(defgroup jao-frm nil + "Frm-base mailbox checker" + :prefix "jao-frm-") + +(defcustom jao-frm-exec-path "frm" + "frm executable path" + :group 'jao-frm + :type 'file) + +(defcustom jao-frm-mail-command 'gnus + "Emacs function to invoke when `g' is pressed on an frm buffer." + :group 'jao-frm + :type 'symbol) + +(defcustom jao-frm-mailboxes nil + "List of mailboxes to check, or directory containing them." + :group 'jao-frm + :type '(choice directory (repeat file))) + +(defface jao-frm-mailno-face '((t (:foreground "dark slate grey"))) + "Face for the mail number." + :group 'jao-frm) + +(defface jao-frm-from-face '((t (:foreground "slate grey"))) + "Face for From: header." + :group 'jao-frm) + +(defface jao-frm-subject-face '((t (:foreground "slate blue"))) + "Face for Subject: header." + :group 'jao-frm) + +(defface jao-frm-mailbox-face '((t (:bold t :weight bold))) + "Face for mailbox name." + :group 'jao-frm) + +;;;; Mode: + +(defvar jao-frm-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map [?q] 'jao-frm-delete-window) + (define-key map [?n] 'next-line) + (define-key map [?p] 'previous-line) + (define-key map [?g] jao-frm-mail-command) + (define-key map [(control k)] 'jao-frm-delete-message) + map)) + +(setq jao-frm-font-lock-keywords + '(("^[^ :]+:" . 'jao-frm-mailbox-face) + ("^\\([ 0-9]+\\):\t+\\([^\t]+\\)\t+\\([^\n]+$\\)" + (1 'jao-frm-mailno-face) + (2 'jao-frm-from-face) + (3 'jao-frm-subject-face)))) + +(defvar jao-frm-mode-syntax-table + (let ((st (make-syntax-table))) + st)) + +(defun jao-frm-mode () + "Major mode for displaying frm output." + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map jao-frm-mode-map) + (set (make-local-variable 'font-lock-defaults) + '(jao-frm-font-lock-keywords)) + (set (make-local-variable 'truncate-lines) t) + (set (make-local-variable 'kill-whole-line) t) + (set (make-local-variable 'next-line-add-newlines) nil) + (setq major-mode 'jao-frm-mode) + (setq mode-name "frm") + (toggle-read-only 1) + (goto-char 1)) + +;;;; Mode commands: +(defvar jao-frm-last-config nil) + +(defun jao-frm-delete-window () + "Delete frm window and restore last win config" + (interactive) + (if (and (consp jao-frm-last-config) + (window-configuration-p (car jao-frm-last-config))) + (progn + (set-window-configuration (car jao-frm-last-config)) + (goto-char (cadr jao-frm-last-config)) + (setq jao-frm-last-config nil)) + (bury-buffer))) + +(defun jao-frm-delete-message () + "Delete message at point" + (interactive) + (when (eq (current-buffer) (get-buffer "*frm*")) + (beginning-of-line) + (when (search-forward-regexp "^ +\\([0-9]+\\):" nil t) + (let ((mn (string-to-number (match-string 1)))) + (when (y-or-n-p (format "Delete message number %d? " mn)) + (toggle-read-only -1) + (shell-command (format "echo 'd %d'|mail" mn) t) + (jao-frm) + (when (= (point-max) (point-min)) + (jao-frm-delete-window) + (message "Mailbox is empty"))))))) + +;;;; Activate frm: +(defun jao-frm-mbox-mails (mbox) + (let ((no (ignore-errors + (substring + (shell-command-to-string (format "frm %s|wc -l" mbox)) 0 -1)))) + (if (stringp no) (string-to-number no) 0))) + +(defun jao-frm-mail-number () + (let ((no 0)) + (dolist (b (jao-frm-mboxes) no) (setq no (+ no (jao-frm-mbox-mails b)))))) + +(defun jao-frm-default-count-formatter (m n) + (format "%s: %s" (file-name-sans-extension (file-name-nondirectory m)) n)) + +(defun jao-frm-mail-counts (fmt) + (let ((fmt (or fmt 'jao-frm-default-count-formatter))) + (remove nil + (mapcar (lambda (m) + (let ((n (jao-frm-mbox-mails m))) + (unless (zerop n) (funcall fmt m n)))) + (jao-frm-mboxes))))) + +(defun jao-frm-display-mailbox (mbox) + (when (not (zerop (jao-frm-mbox-mails mbox))) + (insert (or (file-name-nondirectory mbox) mbox) ":\n\n") + (apply 'call-process + `(,jao-frm-exec-path nil ,(current-buffer) nil + "-n" "-t" ,@(and mbox (list mbox)))) + (newline 2))) + +(defun jao-frm-mboxes () + (cond ((null jao-frm-mailboxes) (list (getenv "MAIL"))) + ((listp jao-frm-mailboxes) jao-frm-mailboxes) + ((stringp jao-frm-mailboxes) + (if (file-directory-p jao-frm-mailboxes) + (directory-files jao-frm-mailboxes t "^[^.]") + (list jao-frm-mailboxes))) + (t (error "Error in mbox specification. Check `jao-frm-mailboxes'")))) + +(defun jao-frm () + "Run frm." + (interactive) + (let ((fbuff (get-buffer-create "*frm*")) + (inhibit-read-only t)) + (if (not (eq fbuff (current-buffer))) + (setq jao-frm-last-config + (list (current-window-configuration) (point-marker)))) + (with-current-buffer fbuff + (delete-region (point-min) (point-max)) + (mapc 'jao-frm-display-mailbox (jao-frm-mboxes)) + (unless (eq major-mode 'jao-frm-mode) + (jao-frm-mode)) + (goto-char (point-min)) + (if (= (point-min) (point-max)) + (message "Mailbox is empty.") + (pop-to-buffer fbuff)) + (when (and (boundp 'display-time-mode) display-time-mode) + (display-time-update))))) + +(defun jao-frm-show-mail-numbers () + (interactive) + (let ((counts (jao-frm-mail-counts nil))) + (message (if counts (mapconcat 'identity counts ", ") "No mail")))) + +(defun jao-frm-mail-string () + (let ((counts (jao-frm-mail-counts + (lambda (m n) + (let ((m (substring (file-name-nondirectory m) 0 1))) + (format "%s %s" m n)))))) + (mapconcat 'identity counts " "))) + +(provide 'jao-frm) + +;;; jao-frm.el ends here diff --git a/net/jao-w3m-session.el b/net/jao-w3m-session.el new file mode 100644 index 0000000..7b8979b --- /dev/null +++ b/net/jao-w3m-session.el @@ -0,0 +1,410 @@ +;;; w3m-session.el --- Persistent emacs-w3m sessions + +;; Copyright (C) 2003, 2004, 2006, 2007, 2008, 2009 Jose A Ortega Ruiz + +;; Author: Jose A Ortega Ruiz +;; Version: 0.3.6 +;; Keywords: hypermedia, w3m, WWW + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; INTRODUCTION: +;; +;; jao-w3m-session provides persistent emacs-w3m browsing sessions. When +;; quitting w3m (or, if you request it, at any other time while using +;; it) you can save the current w3m session (that is, the set of open +;; tabs and the URLs they're visiting). Upon restarting emacs-w3m +;; (possibly after restarting Emacs itself) you'll have the possibity +;; of recovering the saved session (that is, of re-opening the saved +;; tabs and URLs). You also have at your disposal a command to recover +;; the saved session at any other time. +;; +;; INSTALLATION: +;; +;; Just put this file somewhere on your Emacs load path and add the +;; following line to your .emacs file: +;; +;; (require 'jao-w3m-session) +;; +;; After restarting Emacs (or evaluating the form above), each time +;; you start emacs-w3m with 'w3m' you'll get a prompt asking whether +;; your last browsing session should be loaded. Likewise, when +;; quitting the browser, you'll have the possibility of saving your +;; current session (overwriting the previous one). +;; +;; In addition, two new interactive functions are defined: +;; +;; jao-w3m-session-load -- load the last stored session +;; jao-w3m-session-save -- save the current session +;; +;; These functions can be invoked at any time while running emacs-w3m. +;; Optionally, you can bind them to key shortcuts with the proper +;; variations of the following elisp magic in your .emacs: +;; (defun w3m-add-keys () +;; (define-key w3m-mode-map "S" 'jao-w3m-session-save) +;; (define-key w3m-mode-map "L" 'jao-w3m-session-load)) +;; (add-hook 'w3m-mode-hook 'w3m-add-keys) +;; +;; CUSTOMIZATION: +;; +;; A new customization group, jao-w3m-session, is available. There you can +;; customize the following variables: +;; +;; jao-w3m-session-load-always -- if t, `jao-w3m-session-load' will *not* ask +;; for confirmation (default nil) +;; jao-w3m-session-save-always -- if t, `jao-w3m-session-save' will *not* ask +;; for confirmation (default nil) +;; jao-w3m-session-show-titles -- if t, the load prompt will list the +;; session URL titles (default t) +;; jao-w3m-session-duplicate-tabs -- what to do when loading a session that +;; contains a URL already open +;; jao-w3m-session-file -- the file where w3m session info +;; is stored (default "~/.jao-w3m-session") +;; jao-w3m-session-autosave-period -- the period, in seconds, for automatic +;; session backup file updating. +;; +;; +;; You can also customize them in your .emacs file, to wit: +;; +;; (setq jao-w3m-session-file "~/.emacs.d/jao-w3m-session") +;; (setq jao-w3m-session-save-always nil) +;; (setq jao-w3m-session-load-always nil) +;; (setq jao-w3m-session-show-titles t) +;; (setq jao-w3m-session-duplicate-tabs 'ask) ; 'never, 'always, 'ask +;; +;; HISTORY: +;; +;; Version 0.3.7 : +;; +;; - `jao-w3m-session-deactivate-builtin-sessions', to do what it +;; says. +;; +;; Version 0.3.6 (Sat Apr 19, 2008): +;; +;; - w3m-session -> jao-w3m-session to avoid collisions with +;; emacs-w3m's session manager. +;; +;; Version 0.3.5 (Sun Jan 14, 2007): +;; +;; - automatic session backup every `jao-w3m-session-autosave-period' +;; seconds. +;; +;; Version 0.3.4 (Wed Jul 19, 2006): +;; +;; - save session file on quitting Emacs (without using +;; desktop.el) +;; +;; Version 0.3.3 (Thu Jun 8, 2006): +;; +;; - save session file with pretty print. +;; - handle correctly multiple emacs-w3m (re)starts during a +;; single emacs session. +;; - save URLs in hexified form to allow & in them. +;; - code cleanup. +;; +;; Version 0.3.2 (Mon Sep 29, 2003): +;; +;; - bug fix: when searching or going to home/bookmarks/etc, +;; keep the current tab's focus. +;; +;; Version 0.3.1 (Tue Aug 26, 2003): +;; +;; - type of `jao-w3m-session-file' set to 'file' in customisation +;; buffer. +;; - bug fix: syntax error due to a typo in `jao-w3m-session-file' +;; +;; Version 0.3 (Mon Aug 25, 2003): +;; +;; - the load session tab lists the titles of the session's pages +;; (customizable via 'jao-w3m-session-show-titles'). +;; - the duplicated tab prompt displays also the URL's title. +;; - bug fix: active tab in session now is correctly saved. +;; +;; Version 0.2 (Fri Aug 22, 2003): +;; +;; - the session info now includes the active tab, which gets +;; displayed when the session is reloaded. +;; - when reloading a session in a running emacs-w3m, if the +;; session contains a URL that is already being displayed by the +;; browser, the tab can be reused or duplicated (customizable +;; via `jao-w3m-session-duplicate-tabs'). +;; +;; Version 0.1 (Wed Aug 20, 2003) -- Initial release. +;; + + +;;; Code: + +;;; Dependencies: + +(require 'w3m) +(require 'advice) +(require 'url-util) + +;;; Custom variables: + +(defgroup jao-w3m-session nil + "w3m - session saving in w3m." + :group 'w3m + :prefix "jao-w3m-session-") + +(defcustom jao-w3m-session-save-always nil + "If on, always save w3m session without asking." + :group 'jao-w3m-session + :type 'boolean) + +(defcustom jao-w3m-session-load-always nil + "If on, always load w3m session without asking." + :group 'jao-w3m-session + :type 'boolean) + +(defcustom jao-w3m-session-show-titles t + "If on, show URL titles in the load prompt." + :group 'jao-w3m-session + :type 'boolean) + +(defcustom jao-w3m-session-duplicate-tabs 'never + "How to treat session URL already being visited. + +When loading a session with `jao-w3m-session-load', if one of the URLs in +the session is already displayed in a w3m tab, jao-w3m-session can: +- `never' create a new tab (just reload it), or +- `always' duplicate the URL in a new tab, or +- `ask' the user what to do." + :group 'jao-w3m-session + :type '(choice (const :value never) + (const :value always) + (const :value ask))) + +(defcustom jao-w3m-session-file "~/.jao-w3m-session" + "File to save the w3m session data." + :group 'jao-w3m-session + :type 'file) + +(defvar jao-w3m-session-autosave-period 180 + "A backup of the current session is saved with this period (in secs).") + +(defvar jao-w3m-url-filters nil "URL filters.") + +;;; Interactive functions: + +(defun jao-w3m-session-save () + "Save the current w3m session." + (interactive) + (when (and (w3m-alive-p) + (or jao-w3m-session-save-always + (y-or-n-p "Save current w3m session? "))) + (jao-w3m-session-current-to-file) + (jao-w3m-session--restart--autosave))) + +(defun jao-w3m-session-load () + "Load last stored session into w3m." + (interactive) + (let ((s (jao-w3m-session-load-aux))) + (when s + (jao-w3m-session--restart--autosave) + (let* ((urls (jao-w3m-session-url s)) + (offset (jao-w3m-session-offset s)) + (buffers (unless (equal jao-w3m-session-duplicate-tabs 'always) + (jao-w3m-session-find-duplicated urls)))) + (w3m-goto-url-new-session urls t) + (when buffers (jao-w3m-session-close-buffers buffers)) + (unless (zerop offset) (w3m-next-buffer offset)))))) + +(defun jao-w3m-session-set-autosave-period (secs) + "Set new value for the period between session backup autosaves." + (interactive "p") + (let ((secs (or secs (read-number "New period (secs): " 0)))) + (when (> secs 0) + (setq jao-w3m-session-autosave-period secs) + (jao-w3m-session--restart--autosave)))) + +(defun jao-w3m-session-deactivate-builtin-sessions () + "Deactivate emacs-w3m's builtin session handling." + (setq w3m-session-deleted-save nil + w3m-session-autosave nil + w3m-session-deleted-keep-number 0 + w3m-session-crash-recovery nil)) + +;;; Internals: + +;;;; advice w3m to use session management + +(defadvice w3m (before jao-load-session activate) + "Optionally load last w3m session on startup." + (interactive + (let ((s (jao-w3m-session-load-aux))) + (list (or (and s (jao-w3m-session-url s)) w3m-home-page) t t)))) + +(defadvice w3m (after jao-select-tab activate) + "Goto the saved focused tab" + (interactive) + (let ((offset (jao-w3m-session-offset))) + (unless (zerop offset) + (w3m-next-buffer offset)) + (ad-deactivate 'w3m))) + +(defadvice w3m-quit (before jao-save-session activate) + "Save session before quitting." + (interactive) + (jao-w3m-session-save) + ;; this is a little hack: when quitting a w3m session with a tab + ;; selected other than the first, the frame is not automatically + ;; closed as should be when w3m-pop-up-frames is t: + (switch-to-buffer (car (w3m-list-buffers))) + (ad-activate 'w3m)) + +;;;; save session on exit +(add-to-list 'kill-emacs-query-functions + '(lambda () (jao-w3m-session-save) t)) + + +;;;; auxiliary functions + +(defvar jao-w3m-current-session '(jao-w3m-session 0 nil)) + +(defun jao-w3m-session--filter (url filters) + (cond ((not filters) url) + ((string-match-p (caar filters) url) + (cond ((functionp (cdar filters)) (funcall (cadr filters) url)) + ((stringp (cdar filters)) (cdar filters)))) + (t (jao-w3m-session--filter url (cdr filters))))) + +(defun jao-w3m-session--current-urls () + (let ((urls) + (current-buffer (w3m-alive-p)) + (pos 0) + (count 0)) + (dolist (b (w3m-list-buffers) (list pos (reverse urls))) + (set-buffer b) + (let ((url (jao-w3m-session--filter w3m-current-url jao-w3m-url-filters))) + (when url + (when (eq b current-buffer) (setq pos count)) + (setq count (1+ count)) + (push (cons (url-hexify-string url) (w3m-buffer-title b)) urls)))))) + +(defun jao-w3m-session-url (&optional s) + (let ((s (or s jao-w3m-current-session))) + (concat "group:" + (mapconcat 'car (nth 2 s) "&")))) + +(defun jao-w3m-session-offset (&optional s) + (let ((s (or s jao-w3m-current-session))) + (nth 1 s))) + +(defun jao-w3m-session-titles (&optional s) + (let ((s (or s jao-w3m-current-session))) + (mapcar 'cdr (nth 2 s)))) + +(defun jao-w3m-session-current (&optional s) + (save-current-buffer + (setq jao-w3m-current-session + (or s (cons 'jao-w3m-session (jao-w3m-session--current-urls)))))) + +(defun jao-w3m-session-current-url () + (when (w3m-alive-p) + (save-current-buffer + (concat "group:" + (mapconcat (lambda (b) (set-buffer b) w3m-current-url) + (w3m-list-buffers) "&"))))) + +(defun jao-w3m-session-find-duplicated (urls) + (when (w3m-alive-p) + (save-current-buffer + (let* ((duplicate-p + (lambda (b) + (y-or-n-p + (format "'%s' (%s) is already open. Duplicate tab? " + (w3m-buffer-title b) w3m-current-url)))) + (test-b + (lambda (b) + (set-buffer b) + (if (and + (string-match (regexp-quote w3m-current-url) urls) + (or (equal jao-w3m-session-duplicate-tabs 'never) + (not (funcall duplicate-p b)))) + b 'not))) + (buffers (mapcar test-b (w3m-list-buffers)))) + (delete 'not buffers))))) + +(defun jao-w3m-session-close-buffers (buffers) + (save-current-buffer + (mapc 'kill-buffer buffers))) + +(defun jao-w3m-session-load-aux () + (let ((new-session (jao-w3m-session-from-file + (expand-file-name jao-w3m-session-file)))) + (if (and new-session + (or jao-w3m-session-load-always + (y-or-n-p + (if jao-w3m-session-show-titles + (format "Load last w3m session %S? " + (jao-w3m-session-titles new-session)) + "Load last w3m session? ")))) + (jao-w3m-session-current new-session) + nil))) + +(defun jao-w3m-session-from-file (fname) + (let ((fname (jao-w3m-session--check--backup fname))) + (if (file-readable-p fname) + (with-temp-buffer + (insert-file-contents fname) + (goto-char (point-min)) + (let ((sexp (read (current-buffer)))) + (and (equal 'jao-w3m-session (car sexp)) sexp))) + nil))) + +(defsubst jao-w3m-session-current-to-file () + (jao-w3m-session--to--file jao-w3m-session-file)) + +(defun jao-w3m-session--to--file (filename &optional is-auto) + (require 'pp) + (let ((msg (if is-auto (current-message)))) + (with-temp-buffer + (insert ";;;; File generated by jao-w3m-session. DO NOT EDIT!\n") + (pp (jao-w3m-session-current) (current-buffer)) + (insert "\n" ";;;; End of " + (file-name-nondirectory jao-w3m-session-file) "\n") + (write-region (point-min) (point-max) (expand-file-name filename))) + (if is-auto (message msg)))) + +(defvar jao-w3m-session--timer nil) + +(defun jao-w3m-session--backup-name (fname) + (concat (expand-file-name fname) ".bak")) + +(defun jao-w3m-session--check--backup (fname) + (let ((bfname (jao-w3m-session--backup-name fname))) + (if (and (file-newer-than-file-p bfname fname) + (y-or-n-p "A newer autosaved session exists. Use it? ")) + bfname + fname))) + +(defun jao-w3m-session--restart--autosave () + (when (> jao-w3m-session-autosave-period 0) + (if jao-w3m-session--timer (cancel-timer jao-w3m-session--timer)) + (setq jao-w3m-session--timer + (run-at-time jao-w3m-session-autosave-period + jao-w3m-session-autosave-period + 'jao-w3m-session--to--file + (jao-w3m-session--backup-name jao-w3m-session-file) + t)))) + +(provide 'jao-w3m-session) + +;;; jao-w3m-session.el ends here diff --git a/net/jao-weather.el b/net/jao-weather.el new file mode 100644 index 0000000..6760eb1 --- /dev/null +++ b/net/jao-weather.el @@ -0,0 +1,219 @@ +;; Based on code by Thierry Volpiatto +;; (http://mercurial.intuxication.org/hg/xml-weather) + +(require 'xml) +(require 'derived) + + +;;; config: +(defvar jao-weather-format-id-url + "http://xoap.weather.com/search/search?where=%s") + +(defvar jao-weather-format-xml-from-id-url ; id, unit=m,day-forecast=5,login,key + "http://xoap.weather.com/weather/local/%s?cc=*&unit=%s&dayf=%s&prod=xoap&par=%s&key=%s") + +(defvar jao-weather-unit "m" + "*m mean metric, you will have wind speed in km/h, temperature in °C and so on.") + +(defvar jao-weather-login nil) +(defvar jao-weather-key nil) + +(defvar jao-weather-day-forecast-num 5 + "*Number of days for forecast; Maximum 5.") + +(defvar jao-weather-default-id "SPXX0015") + +(defvar jao-weather-timer-delay 3600) + +(defvar jao-weather-last-data nil) + + +;;; access: +(defun jao-weather-authentify () + "Authentify user from .authinfo file. +You have to setup correctly `auth-sources' to make this function +finding the path of your .authinfo file that is normally ~/.authinfo. +Entry in .authinfo should be: +machine xoap.weather.com port http login xxxxx password xxxxxx" + (let ((auth (auth-source-user-or-password '("login" "password") + "xoap.weather.com" + "http"))) + (setq jao-weather-login (car auth) + jao-weather-key (cadr auth)))) + +(defun jao-weather--url (id) + (unless (and jao-weather-login jao-weather-key) + (jao-weather-authentify)) + (format jao-weather-format-xml-from-id-url + (or id jao-weather-default-id) + jao-weather-unit + (min jao-weather-day-forecast-num 5) + jao-weather-login + jao-weather-key)) + +(defvar jao-weather-hook nil) + +;; http://xoap.weather.com/weather/local/[locid] +;; Replace the [locid], of course, with the location ID obtained in the previous step. +;; Appended to this URL is a mix of other parameters, +;; some required and some optional. A typical example might be: +;; http://xoap.weather.com/weather/local/NLXX0002?cc=*&dayf=5&prod=xoap&par=[partner id]&key=[license key] +(defun jao-weather--get-info-async (&optional id) + (let ((url (jao-weather--url id)) + (url-show-status nil)) + (url-retrieve url (lambda (res) + (when (not res) + (let ((data (jao-weather-get-alist))) + (when data + (setq jao-weather-last-data data) + (run-hooks 'jao-weather-hook)))) + (kill-buffer (current-buffer)))))) + +(defun jao-weather--get-info-now (&optional id) + (let* ((url (jao-weather--url id)) + (buffer (url-retrieve-synchronously url)) + (data (and buffer + (with-current-buffer buffer + (jao-weather-get-alist))))) + (when buffer (kill-buffer buffer)) + (when data + (setq jao-weather-last-data data) + (run-hooks 'jao-weather-hook)) + data)) + + +;;; formatting: +(defun jao-weather--flist (c fs) + (when c + (let (result) + (dolist (f fs result) + (let ((v (caddr (assoc (cadr f) c)))) + (when (and (stringp v) (not (string-equal v "N/A"))) + (push (cons (car f) v) result))))))) + +(defun jao-weather--parse-cc (cc) + (append (jao-weather--flist cc '((:date lsup) + (:observatory obst) + (:temperature tmp) + (:condition t) + (:pressure r))) + (jao-weather--flist (assoc 'wind cc) '((:windir d) + (:wind-tilt t) + (:gust gust))))) + +(defun jao-weather--parse-location (loc) + (jao-weather--flist loc '((:city dnam) + (:time tm) + (:latitude lat) + (:longitude lon) + (:sunrise sunr) + (:sunset suns)))) + +(defun jao-weather--parse-day (d) + (let ((p2 (assoc 'part + (remove (assoc 'part (cdr d)) + (cdr d)))) + (wday (or (cdr (assoc 't (cadr d))) "day"))) + `(,(cdr (assoc 'dt (cadr d))) + (:weekday . ,wday) + (:weekday-abbrev . ,(substring wday 0 3)) + ,@(jao-weather--flist (cdr d) '((:max hi) + (:min low) + (:sunrise sunr) + (:sunset suns) + (:humidity hmid))) + ,@(jao-weather--flist (assoc 'wind (assoc 'part (cdr d))) + '((:wind-dir 't) (:wind-speed 's))) + ,@(jao-weather--flist (assoc 'wind p2) '((:night-wind-dir wea) + (:night-wind-speed s))) + ,@(jao-weather--flist p2 + '((:night-condition t) (:night-humidity hmid)))))) + +(defun jao-weather-get-alist () + (let* ((pxml (car (xml-parse-region (point-min) (point-max)))) + (loc (car (xml-get-children pxml 'loc))) + (cc (car (xml-get-children pxml 'cc))) + (dayf (xml-get-children pxml 'dayf)) + (dayfs (xml-get-children (car dayf) 'day)) + (today (append (jao-weather--parse-cc cc) + (jao-weather--parse-location loc))) + (forecast (mapcar 'jao-weather--parse-day dayfs))) + `((today ,@today) (forecast ,@forecast)))) + +(defun jao-weather--format-fields (data fields sep) + (if data + (mapconcat '(lambda (kv) + (let ((v (cdr (assoc (car kv) data)))) + (if (not v) "" + (format (or (cdr kv) "%s") v)))) + fields + sep) + "")) + +(defsubst jao-weather--today-string (fields sep) + (jao-weather--format-fields (cdr (assoc 'today jao-weather-last-data)) + fields sep)) + +(defun jao-weather--forecast-string (n fields sep) + (jao-weather--format-fields (nth n (cdr (assoc 'forecast + jao-weather-last-data))) + fields sep)) + + +;;; update daemon: +(defvar jao-weather--timer nil) +(defun jao-weather-start (&optional delay) + (interactive) + (jao-weather-stop) + (setq jao-weather--timer + (run-with-timer (or delay 0) + jao-weather-timer-delay + 'jao-weather--get-info-async))) + +(defun jao-weather-stop () + (interactive) + (when jao-weather--timer + (cancel-timer jao-weather--timer) + (setq jao-weather--timer nil))) + + +;;; today +(defun jao-weather-today-msg (&optional arg) + (interactive "p") + (when (> arg 4) (jao-weather--get-info-now)) + (if (= 4 arg) (jao-weather-forecast-msg) + (message "%s" (jao-weather--today-string '((:temperature . " %s°C") + (:condition . "(%s)") + (:sunrise . "↑ %s") + (:sunset . "↓ %s") + (:date . "[%s]")) + " ")))) + +(defun jao-weather-forecast-msg (&optional arg) + (interactive "P") + (when arg (jao-weather--get-info-now)) + (message " %s" (mapconcat + (lambda (n) + (jao-weather--forecast-string n + '((:weekday-abbrev . "%s ") + (:max . "%s°/") + (:min . "%s°") + (:condition . ", %s") + (:night-condition . ", %s")) + "")) + '(1 2 3 4) " | "))) + +(defun jao-weather-temperature () + (string-to-number (jao-weather--today-string '((:temperature)) ""))) + + +(defun jao-weather-temperature* (&optional sep) + (concat (jao-weather--today-string '((:temperature . "%s°")) "") + (or sep " ") + (jao-weather--forecast-string 1 + '((:max . "%s°/") (:min . "%s°") + (:night-condition . " %s")) + ""))) + +;; Provide +(provide 'jao-weather) -- cgit v1.2.3