view lisp/url/url-news.el @ 104154:c63f8623fb66

* progmodes/gdb-mi.el (gdb-frame-number): Initialize with nil. (gdb-overlay-arrow-position): Renamed to `gdb-disassembly-position'. (gdb-overlay-arrow-position, gdb-thread-position) (gdb-disassembly-position): Declare variables. (gdb-wait-for-pending): Function now. (gdb-add-subscriber, gdb-delete-subscriber, gdb-get-subscribers) (gdb-emit-signal, gdb-buf-publisher): Declare before first use so compilation goes smoothly. (gdb, gdb-non-stop, gdb-buffers): New customization groups. (gdb-non-stop-setting): New customization setting which replaces `gdb-non-stop' so changing it doesn't break active GDB session. (gdb-stack-buffer-locations, gdb-stack-buffer-addresses) (gdb-thread-buffer-verbose-names, gdb-thread-buffer-arguments) (gdb-thread-buffer-locations, gdb-thread-buffer-addresses) (gdb-show-threads-by-default): New customization options. (gdb-buffer-type, gdb-buffer-shows-main-thread-p): New helper routines. (gdb-get-buffer-create): Send buffers update signal when they are created. (gdb-invalidate-locals, gdb-invalidate-registers) (gdb-invalidate-breakpoints) (gdb-invalidate-threads, gdb-invalidate-disassembly) (gdb-invalidate-memory): Accept update signal. (gdb-current-context-command): Use --frame option. (gdb-update-gud-running, gdb-running, gdb-setq-thread-number): Implement `gdb-frame-number' selection logic. (gdb-show-run-p, gdb-show-stop-p): Helper functions which decide whether to show GUD toolbar buttons. (gdb-thread-exited): Unselect current thread when it exits. (gdb-stopped): Typo fixed (now really runs `gdb-stopped-hooks'). (gdb-mark-line): Routine which sets overlay arrow or inverses video on fringeless displays. (gdb-table, gdb-table-add-row, gdb-table-string): Structure used to build aligned columns of data in GDB buffers and set text properties line-by-line. (gdb-invalidate-breakpoints) (gdb-breakpoints-list-handler-custom) (gdb-thread-list-handler-custom, gdb-disassembly-handler-custom) (gdb-stack-list-frames-custom, gdb-locals-handler-custom) (gdb-registers-handler-custom): Align data columns. (gdb-locals-handler-custom): Now prints data like in variable declarations. (gdb-jump-to, gdb-file-button, gdb-insert-file-location-button): Removed confusing buttons. (gdb-invalidate-threads): Append --frame. (gdb-threads-mode-map, gdb-breakpoints-mode-map): TAB to switch between breakpoints/threads buffers. (gdb-set-window-buffer): Now can ignore dedicated windows. (gdb-propertize-header): Use `gdb-set-window-buffer'. (def-gdb-thread-buffer-simple-command): Numerous typos fixed. (def-gdb-thread-buffer-gud-command): Replaces `def-gdb-thread-buffer-gdb-command' and uses standard GUD commands for fine thread control. (gdb-preempt-existing-or-display-buffer): New function used to display bound buffers without breaking window layout. (gdb-frame-location): Replaces `gdb-insert-frame-location'. (gdb-select-frame): New version of `gdb-frames-select' which now sets `gdb-frame-number' so commands may use --frame option instead of inner debugger state. (gdb-frame-handler): Do not set `gdb-frame-number'. (gdb-threads-mode-map): Select threads with mouse.

;;; url-news.el --- News Uniform Resource Locator retrieval code

;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.

;; Keywords: comm, data, processes

;; 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 <http://www.gnu.org/licenses/>.

;;; Code:

(require 'url-vars)
(require 'url-util)
(require 'url-parse)
(require 'nntp)
(autoload 'url-warn "url")
(autoload 'gnus-group-read-ephemeral-group "gnus-group")

(defgroup url-news nil
  "News related options."
  :group 'url)

(defun url-news-open-host (host port user pass)
  (if (fboundp 'nnheader-init-server-buffer)
      (nnheader-init-server-buffer))
  (nntp-open-server host (list port))
  (if (and user pass)
      (progn
	(nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
	(nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass)
	(if (not (nntp-server-opened host))
	    (url-warn 'url (format "NNTP authentication to `%s' as `%s' failed"
				   host user))))))

(defun url-news-fetch-message-id (host message-id)
  (let ((buf (generate-new-buffer " *url-news*")))
    (if (eq ?> (aref message-id (1- (length message-id))))
	nil
      (setq message-id (concat "<" message-id ">")))
    (if (cdr-safe (nntp-request-article message-id nil host buf))
	;; Successfully retrieved the article
	nil
      (with-current-buffer buf
	(insert "Content-type: text/html\n\n"
		"<html>\n"
		" <head>\n"
		"  <title>Error</title>\n"
		" </head>\n"
		" <body>\n"
		"  <div>\n"
		"   <h1>Error requesting article...</h1>\n"
		"   <p>\n"
		"    The status message returned by the NNTP server was:"
		"<br><hr>\n"
		"    <xmp>\n"
		(nntp-status-message)
		"    </xmp>\n"
		"   </p>\n"
		"   <p>\n"
		"    If you If you feel this is an error, <a href=\""
		"mailto:" url-bug-address "\">send mail</a>\n"
		"   </p>\n"
		"  </div>\n"
		" </body>\n"
		"</html>\n"
		"<!-- Automatically generated by URL v" url-version " -->\n"
		)))
    buf))

(defvar gnus-group-buffer)

(defun url-news-fetch-newsgroup (newsgroup host)
  (if (string-match "^/+" newsgroup)
      (setq newsgroup (substring newsgroup (match-end 0))))
  (if (string-match "/+$" newsgroup)
      (setq newsgroup (substring newsgroup 0 (match-beginning 0))))

  ;; This saves us from checking new news if Gnus is already running
  ;; FIXME - is it relatively safe to use gnus-alive-p here? FIXME
  (if (or (not (get-buffer gnus-group-buffer))
	  (with-current-buffer gnus-group-buffer
	    (not (eq major-mode 'gnus-group-mode))))
      (gnus))
  (set-buffer gnus-group-buffer)
  (goto-char (point-min))
  (gnus-group-read-ephemeral-group newsgroup
				   (list 'nntp host
					 (list 'nntp-open-connection-function
					       nntp-open-connection-function))
				   nil
				   (cons (current-buffer) 'browse)))

;;;###autoload
(defun url-news (url)
  ;; Find a news reference
  (let* ((host (or (url-host url) url-news-server))
	 (port (url-port url))
	 (article-brackets nil)
	 (buf nil)
	 (article (url-unhex-string (url-filename url))))
    (url-news-open-host host port (url-user url) (url-password url))
    (cond
     ((string-match "@" article)	; Its a specific article
      (setq buf (url-news-fetch-message-id host article)))
     ((string= article "")		; List all newsgroups
      (gnus))
     (t					; Whole newsgroup
      (url-news-fetch-newsgroup article host)))
    buf))

;;;###autoload
(defun url-snews (url)
  (let ((nntp-open-connection-function (if (eq 'ssl url-gateway-method)
					   'nntp-open-ssl-stream
					 'nntp-open-tls-stream)))
    (url-news url)))

(provide 'url-news)

;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311
;;; url-news.el ends here