;;; bonjourmadame.el --- Say "Hello ma'am!" ;; Time-stamp: <2017-09-19 13:33:46> ;; Copyright (C) 2015 Pierre Lecocq ;; Version: 0.6 ;; Package-Version: 20170919.1134 ;; This program 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 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Display the image from bonjourmadame.fr ;; Updated every day at 10AM (on Europe/Paris timezone) ;; ;; Keys: ;; ;; - n: get the next image ;; - p: get the previous image ;; - h: hide the buffer (switch to the previous one) ;; - q: quit (kill the buffer) ;;;; Changelog: ;; v0.6: change base URL after the main domain outage - by ShadowMitia (Dimitri Belopopsky) ;; v0.5: display title, use rx and stick to XDG_CACHE_HOME standard - by Schnouki (Thomas Jost) ;; v0.4: display and time bug fixes ;; v0.3: add page navigation ;; v0.2: make it a major mode ;; v0.1: first release ;;;; Contributors: ;; - Schnouki (Thomas Jost) ;;; Code: (require 'rx) (require 'web-mode nil t) (declare-function web-mode-dom-entities-replace "web-mode") (defgroup bonjourmadame nil "Say \"Hello ma'am!\"" :group 'image) (defvar bonjourmadame--cache-dir (concat (or (getenv "XDG_CACHE_HOME") "~/.cache") "/bonjourmadame")) (defvar bonjourmadame--buffer-name "*Bonjour Madame*") (defvar bonjourmadame--base-url "http://dites.bonjourmadame.fr") (defvar bonjourmadame--refresh-hour 10) (defvar bonjourmadame--regexp (rx ""))) ">")) (defvar bonjourmadame--image-time nil) (defvar bonjourmadame--image-url "") (defvar bonjourmadame--image-title "") (defvar bonjourmadame--previous-buffer nil) (defvar bonjourmadame--page 1) (define-derived-mode bonjourmadame-mode special-mode "bonjourmadame" "Say Hello ma'am!" :group 'bonjourmadame) (define-key bonjourmadame-mode-map (kbd "n") 'bonjourmadame-next) (define-key bonjourmadame-mode-map (kbd "p") 'bonjourmadame-prev) (define-key bonjourmadame-mode-map (kbd "h") 'bonjourmadame-hide) (define-key bonjourmadame-mode-map (kbd "q") 'bonjourmadame-quit) (defun bonjourmadame--get-image-url () "Get the image URL." (let ((url (concat bonjourmadame--base-url "/page/" (number-to-string bonjourmadame--page)))) (with-current-buffer (url-retrieve-synchronously url) (goto-char (point-min)) (re-search-forward bonjourmadame--regexp nil t) (setq bonjourmadame--image-url (match-string 1) bonjourmadame--image-title (match-string 2)) (kill-buffer))) bonjourmadame--image-url) (defun bonjourmadame--get-image-path () "Get the local image path." (set-time-zone-rule "Europe/Paris") (setq bonjourmadame--image-time (current-time)) (when (> bonjourmadame--page 1) (setq bonjourmadame--image-time (time-subtract bonjourmadame--image-time (seconds-to-time (* (- bonjourmadame--page 1) 60 60 24))))) (let ((current-hour (string-to-number (format-time-string "%H")))) (when (< current-hour bonjourmadame--refresh-hour) (message "Wait at most %dh to get a newer image!" (- bonjourmadame--refresh-hour current-hour)) (setq bonjourmadame--image-time (time-subtract bonjourmadame--image-time (seconds-to-time (* bonjourmadame--refresh-hour 60 60)))))) (concat (file-name-as-directory bonjourmadame--cache-dir) (format "%s.png" (format-time-string "%Y-%m-%d" bonjourmadame--image-time)))) (defun bonjourmadame--get-title () "Get the image title." (let* ((title-path (concat (bonjourmadame--get-image-path) ".txt")) (title (if (file-exists-p title-path) (with-temp-buffer (save-excursion (insert-file-contents-literally title-path)) ;; Escaping HTML entities is hard! (iso-sgml2iso (point-min) (point-max)) (html2text) (when (featurep 'web-mode) (web-mode-dom-entities-replace)) (buffer-substring-no-properties (point-min) (point-max))) ""))) (replace-regexp-in-string "^\s+" "" (replace-regexp-in-string "\s+\\'" "" (replace-regexp-in-string (rx (1+ (any blank " "))) " " title))))) (defun bonjourmadame--download-image () "Download and store the image." (unless (file-accessible-directory-p bonjourmadame--cache-dir) (make-directory bonjourmadame--cache-dir t)) (let* ((image-path (bonjourmadame--get-image-path)) (title-path (concat image-path ".txt"))) (unless (file-exists-p image-path) (url-copy-file (bonjourmadame--get-image-url) image-path)) (unless (file-exists-p title-path) (with-temp-file title-path (insert bonjourmadame--image-title))))) (defun bonjourmadame--max-image-size (buf) "Determine the max size to use to display the image. BUF must be the target buffer." (let* ((window (get-buffer-window buf)) (frame (window-frame window))) (cons (window-pixel-width window) (- (window-pixel-height window) (* 3 (frame-char-height frame)))))) (defcustom bonjourmadame-max-image-size-function 'bonjourmadame--max-image-size "Function used to compute the max size for the image. The return value must be a (max-width . max-height) cons cell." :type '(function)) (defun bonjourmadame--display-image () "Display the image." (unless (display-graphic-p) (error "bonjourmadame is only available in graphical mode. You might want to execute `bonjourmadame-browse' instead.")) (bonjourmadame--download-image) (let* ((image-path (bonjourmadame--get-image-path)) (title (bonjourmadame--get-title)) (buf (current-buffer)) (max-size (if bonjourmadame-max-image-size-function (apply bonjourmadame-max-image-size-function (list buf)) nil)) (extra-params (when (and max-size (image-type-available-p 'imagemagick)) (list 'imagemagick nil :max-width (car max-size) :max-height (cdr max-size)))) (image (apply 'create-image (cons image-path extra-params)))) (when (not (equal (buffer-name buf) bonjourmadame--buffer-name)) (setq bonjourmadame--previous-buffer buf)) (switch-to-buffer bonjourmadame--buffer-name) (when buffer-read-only (setq inhibit-read-only t)) (erase-buffer) (insert-image image) (insert (format "\n\n%s: %s" (format-time-string "%Y-%m-%d" bonjourmadame--image-time) title)) (bonjourmadame-mode) (read-only-mode) (goto-char (point-min)) (when max-size (add-hook 'window-configuration-change-hook 'bonjourmadame--display-image nil t)))) (defun bonjourmadame-next () "Display the next image." (interactive) (setq bonjourmadame--page (+ bonjourmadame--page 1)) (bonjourmadame--display-image)) (defun bonjourmadame-prev () "Display the previous image." (interactive) (when (> bonjourmadame--page 1) (setq bonjourmadame--page (- bonjourmadame--page 1)) (bonjourmadame--display-image))) (defun bonjourmadame-hide () "Hide the buffer." (interactive) (switch-to-buffer bonjourmadame--previous-buffer)) (defun bonjourmadame-quit () "Quit." (interactive) (setq bonjourmadame--page 1) (setq bonjourmadame--image-time nil) (setq bonjourmadame--image-url "") (kill-buffer (get-buffer bonjourmadame--buffer-name)) (switch-to-buffer bonjourmadame--previous-buffer) (message "Au revoir madame")) ;;;###autoload (defun bonjourmadame-browse () "Browse to the site." (interactive) (browse-url bonjourmadame--base-url)) ;;;###autoload (defun bonjourmadame () "Say Hello ma'am!" (interactive) (bonjourmadame--display-image)) (provide 'bonjourmadame) ;;; bonjourmadame.el ends here