From 266c63b5c13c519c2deb051de10fdfea2470c4c3 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 10 Jun 2013 11:46:27 +0000 Subject: [PATCH] lisp/gnus/sieve.el: Fix handling of PORT parameter, quitting --- lisp/gnus/ChangeLog | 17 +++++ lisp/gnus/eww.el | 155 ++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus/shr.el | 3 +- lisp/gnus/sieve.el | 13 ++-- 4 files changed, 181 insertions(+), 7 deletions(-) create mode 100644 lisp/gnus/eww.el diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 2c2880ee398..ee540465a3c 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,20 @@ +2013-06-10 Lars Magne Ingebrigtsen + + * eww.el: Don't require cl-lib. + + * eww.el: Start writing a new, tiny web browser. + (eww-previous-url): New command. + (eww-quit): New command. + +2013-06-10 Albert Krewinkel + + * sieve.el: Put point at beginning of buffer when viewing a script. + (sieve-open-server): respect the PORT parameter. Show the correct port + number in sieve-buffer's header. Fixed code to also work with a string + as port specifier. Properly close the connection on pressing 'q'. Make + sieve-manage-quit close the connection and process buffer. Also, remove + duplicate keybinding for 'q'. + 2013-06-10 Roy Hashimoto (tiny change) * mm-view.el (mm-pkcs7-signed-magic): Allow newline in the regexp and diff --git a/lisp/gnus/eww.el b/lisp/gnus/eww.el new file mode 100644 index 00000000000..c4a664022ac --- /dev/null +++ b/lisp/gnus/eww.el @@ -0,0 +1,155 @@ +;;; eww.el --- Emacs Web Wowser + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: html + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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. If not, see . + +;;; Commentary: + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'shr) +(require 'url) + +(defvar eww-current-url nil) +(defvar eww-history nil) + +(defun eww (url) + "Fetch URL and render the page." + (interactive "sUrl: ") + (url-retrieve url 'eww-render (list url))) + +(defun eww-render (status url &optional point) + (let* ((headers (eww-parse-headers)) + (content-type + (mail-header-parse-content-type + (or (cdr (assoc "content-type" headers)) + "text/plain"))) + (charset (intern + (downcase + (or (cdr (assq 'charset (cdr content-type))) + "utf8")))) + (data-buffer (current-buffer))) + (unwind-protect + (progn + (cond + ((equal (car content-type) "text/html") + (eww-display-html charset url)) + ((string-match "^image/" (car content-type)) + (eww-display-image)) + (t + (eww-display-raw charset))) + (when point + (goto-char point))) + (kill-buffer data-buffer)))) + +(defun eww-parse-headers () + (let ((headers nil)) + (while (and (not (eobp)) + (not (eolp))) + (when (looking-at "\\([^:]+\\): *\\(.*\\)") + (push (cons (downcase (match-string 1)) + (match-string 2)) + headers)) + (forward-line 1)) + (unless (eobp) + (forward-line 1)) + headers)) + +(defun eww-display-html (charset url) + (unless (eq charset 'utf8) + (decode-coding-region (point) (point-max) charset)) + (let ((document + (list + 'base (list (cons 'href url)) + (libxml-parse-html-region (point) (point-max))))) + (eww-setup-buffer) + (setq eww-current-url url) + (let ((inhibit-read-only t)) + (shr-insert-document document)) + (goto-char (point-min)))) + +(defun eww-display-raw (charset) + (let ((data (buffer-substring (point) (point-max)))) + (eww-setup-buffer) + (let ((inhibit-read-only t)) + (insert data)) + (goto-char (point-min)))) + +(defun eww-display-image () + (let ((data (buffer-substring (point) (point-max)))) + (eww-setup-buffer) + (let ((inhibit-read-only t)) + (shr-put-image data nil)) + (goto-char (point-min)))) + +(defun eww-setup-buffer () + (pop-to-buffer (get-buffer-create "*eww*")) + (let ((inhibit-read-only t)) + (erase-buffer)) + (eww-mode)) + +(defvar eww-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "q" 'eww-quit) + (define-key map [tab] 'widget-forward) + (define-key map [backtab] 'widget-backward) + (define-key map [delete] 'scroll-down-command) + (define-key map "\177" 'scroll-down-command) + (define-key map " " 'scroll-up-command) + (define-key map "p" 'eww-previous-url) + ;;(define-key map "n" 'eww-next-url) + map)) + +(defun eww-mode () + "Mode for browsing the web. + +\\{eww-mode-map}" + (interactive) + (setq major-mode 'eww-mode + mode-name "eww") + (set (make-local-variable 'eww-current-url) 'author) + (set (make-local-variable 'browse-url-browser-function) 'eww-browse-url) + (setq buffer-read-only t) + (use-local-map eww-mode-map)) + +(defun eww-browse-url (url &optional new-window) + (push (list eww-current-url (point)) + eww-history) + (eww url)) + +(defun eww-quit () + "Exit the Emacs Web Wowser." + (interactive) + (setq eww-history nil) + (kill-buffer (current-buffer))) + +(defun eww-previous-url () + "Go to the previously displayed page." + (interactive) + (when (zerop (length eww-history)) + (error "No previous page")) + (let ((prev (pop eww-history))) + (url-retrieve (car prev) 'eww-render (list (car prev) (cadr prev))))) + +(provide 'eww) + +;;; eww.el ends here diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 9284da4c4b3..6e0aa26e376 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -945,7 +945,8 @@ ones, in case fg and bg are nil." plist))) (defun shr-tag-base (cont) - (setq shr-base (cdr (assq :href cont)))) + (setq shr-base (cdr (assq :href cont))) + (shr-generic cont)) (defun shr-tag-a (cont) (let ((url (cdr (assq :href cont))) diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el index 0e46cb66361..2c11c039d56 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/gnus/sieve.el @@ -109,7 +109,6 @@ require \"fileinto\"; ;; various (define-key map "?" 'sieve-help) (define-key map "h" 'sieve-help) - (define-key map "q" 'kill-buffer) ;; activating (define-key map "m" 'sieve-activate) (define-key map "u" 'sieve-deactivate) @@ -152,6 +151,8 @@ require \"fileinto\"; (defun sieve-manage-quit () "Quit." (interactive) + (sieve-manage-close sieve-manage-buffer) + (kill-buffer sieve-manage-buffer) (kill-buffer (current-buffer))) (defun sieve-activate (&optional pos) @@ -206,6 +207,7 @@ require \"fileinto\"; (insert sieve-template)) (sieve-mode) (setq sieve-buffer-script-name name) + (beginning-of-buffer) (message (substitute-command-keys "Press \\[sieve-upload] to upload script to server.")))) @@ -256,10 +258,9 @@ Used to bracket operations which move point in the sieve-buffer." (setq buffer-read-only nil) (erase-buffer) (buffer-disable-undo) - (insert "\ -Server : " server ":" (or port sieve-manage-default-port) " - -") + (let* ((port (or port sieve-manage-default-port)) + (header (format "Server : %s:%s\n\n" server port))) + (insert header)) (set (make-local-variable 'sieve-buffer-header-end) (point-max))) @@ -305,7 +306,7 @@ Server : " server ":" (or port sieve-manage-default-port) " (with-current-buffer (or ;; open server (set (make-local-variable 'sieve-manage-buffer) - (sieve-manage-open server)) + (sieve-manage-open server port)) (error "Error opening server %s" server)) (sieve-manage-authenticate))) -- 2.39.2