+2004-01-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lisp/gnus-clfns.el: Abolish.
+ * lisp/nnshimbun.el: Abolish.
+
+ * lisp/dgnushack.el: Allow loading dgnushack.el w/o dgnuspath.el.
+
+2004-01-05 Jesper Harder <harder@ifa.au.dk>
+
+ * make.bat: Add missing parens. From Robert Marshall
+ <spam@chezmarshall.freeserve.co.uk>.
+
2004-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
* aclocal.m4 (AC_CHECK_EMACS_FLAVOR): Don't check for Mule 2.
+2004-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * run-at-time.el: New file.
+
+ * dgnushack.el (dgnushack-compile): Don't compile run-at-time
+ under Emacs.
+
+ * gnus.el ((fboundp 'gnus-set-text-properties)): Remove definition
+ of gnus-set-text-properties.
+
+ * gnus-uu.el (gnus-uu-save-article): Ditto.
+
+ * gnus-salt.el (gnus-carpal-setup-buffer): Ditto.
+
+ * gnus-cite.el (gnus-cite-parse): Ditto.
+
+ * gnus-art.el (gnus-button-push): Use set-text-properties instead
+ of gnus-.
+
+ * gnus-xmas.el (run-at-time): Require run-at-time.
+
+ * gnus.el: Changed calls to nnheader-run-at-time and
+ password-run-at-time throughout to use run-at-time directly.
+
+ * password.el: Removed definition of run-at-time.
+
+ * nnheaderxm.el: Remove definition of run-at-time.
+
+2004-01-05 Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>
+
+ * mml.el (mml-minibuffer-read-disposition): Show attachment type
+ in prompt (tiny change)
+
+2004-01-06 Steve Youngs <sryoungs@bigpond.net.au>
+
+ * messagexmas.el (message-xmas-redefine): Alias
+ `message-make-caesar-translation-table' to
+ ``message-xmas-make-caesar-translation-table' regardless of XEmacs
+ version.
+
+ * gnus-xmas.el (gnus-xmas-set-text-properties): Removed.
+ (gnus-xmas-define): Don't alias `gnus-set-text-properties' to
+ `gnus-xmas-set-text-properties'.
+ (gnus-xmas-redefine): Don't alias `gnus-completing-read' to
+ `gnus-xmas-completing-read'.
+ (gnus-xmas-completing-read): Removed.
+ (gnus-xmas-open-network-stream): Removed.
+
+ * gnus-ems.el (gnus-mode-line-modified): Don't conditionalise on
+ XEmacs version.
+
+ * dns.el (dns-make-network-process): Use `open-network-stream'
+ instead of `gnus-xmas-open-network-stream'.
+
+ * dgnushack.el: Remove some XEmacs 21.1 specific stuff.
+
+ * .cvsignore: Add auto-autoloads.el, custom-load.el.
+
+2004-01-06 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-mime-display-alternative)
+ (gnus-insert-mime-button, gnus-insert-mime-security-button)
+ (gnus-insert-prev-page-button, gnus-insert-next-page-button):
+ Don't use gnus-local-map-property.
+
+ * gnus-util.el (gnus-local-map-property): Remove.
+
+ * mm-view.el (mm-view-pkcs7-decrypt): Replace
+ gnus-completing-read-maybe-default with completing-read.
+
+ * gnus-util.el (gnus-completing-read): do.
+ (gnus-completing-read-maybe-default): Remove.
+
+2004-01-06 Steve Youngs <sryoungs@bigpond.net.au>
+
+ * password.el: Only autoload `run-at-time' if not XEmacs.
+ Only autoload the itimer functions if XEmacs.
+
+2004-01-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-xmas.el (gnus-xmas-define): Defun char-width for non-MULE
+ XEmacsen.
+
+ * dgnushack.el: Autoload executable-find for XEmacs.
+
+2004-01-06 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-read-string): Remove.
+ (gnus-summary-pipe-to-muttprint): Replace gnus-read-string with
+ read-string.
+
+2004-01-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * netrc.el: autoload password-read
+ (netrc): new configuration group
+ (netrc-encoding-method, netrc-openssl-path): configuration
+ variables for encoding and decoding of files with symmetric
+ ciphers
+ (netrc-encode): assistant function to encode a file with
+ netrc-encoding-method
+ (netrc-parse): added interactive parameter, added optional
+ decoding if netrc-encoding-method is non-nil but otherwise
+ behavior is standard
+ (netrc-encrypting-method, netrc-encrypt, netrc-parse):
+ s/encode/encrypt/ everywhere
+
+ * spam.el: remove executable-find autoload
+
+2004-01-05 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-registry.el: Remove Emacs 20 hash table compatibility code.
+
+ * gnus-uu.el (gnus-uu-post-encoded): bury-buffer is always fbound.
+
+2004-01-05 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-treat-ansi-sequences,
+ article-treat-ansi-sequences): New variable and function.
+ Suggested by Dan Jacobson <jidanni@jidanni.org>.
+
+ * gnus-sum.el (gnus-summary-wash-map, gnus-summary-make-menu-bar):
+ Use it.
+
+2004-01-05 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-util.el (mm-quote-arg): Remove.
+
+ * mm-decode.el (mm-mailcap-command): Replace mm-quote-arg with
+ shell-quote-argument.
+
+ * gnus-uu.el (gnus-uu-command): do.
+
+ * gnus-sum.el (gnus-summary-insert-pseudos): do.
+
+ * ietf-drums.el (ietf-drums-token-to-list): Replace mm-make-char
+ with make-char.
+
+ * mm-util.el (mm-make-char): Remove.
+
+ * mml.el (mml-mode): Replace gnus-add-minor-mode with
+ add-minor-mode.
+
+ * gnus-undo.el (gnus-undo-mode): do.
+
+ * gnus-topic.el (gnus-topic-mode): do.
+
+ * gnus-sum.el (gnus-dead-summary-mode): do.
+
+ * gnus-start.el (gnus-slave-mode): do.
+
+ * gnus-salt.el (gnus-binary-mode, gnus-pick-mode): do.
+
+ * gnus-ml.el (gnus-mailing-list-mode): do.
+
+ * gnus-gl.el (gnus-grouplens-mode): do.
+
+ * gnus-draft.el (gnus-draft-mode): do.
+
+ * gnus-dired.el (gnus-dired-mode): do.
+
+ * gnus-ems.el (gnus-add-minor-mode): Remove.
+
+ * gnus-spec.el (gnus-correct-length, gnus-correct-substring):
+ Replace gnus-char-width with char-width.
+
+ * gnus-ems.el (gnus-char-width): Remove.
+
+ * gnus-spec.el (gnus-correct-length, gnus-correct-substring):
+ Replace gnus-char-width with char-width.
+
+ * gnus-ems.el (gnus-char-width): Remove.
+
+ * spam-stat.el (with-syntax-table): Remove with-syntax-table
+ definition.
+ Remove Emacs 20 hash table compatibility code.
+
+ * rfc2047.el (with-syntax-table): Remove with-syntax-table Emacs
+ 20 compatibility code.
+
+ * spam.el (spam-point-at-eol): Replace with point-at-eol.
+
+ * smime.el (smime-point-at-eol): Replace with point-at-eol.
+
+ * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): Replace
+ with point-at-{eol,bol}.
+
+ * netrc.el (netrc-point-at-eol): Replace with point-at-eol.
+
+ * imap.el (imap-point-at-eol): Replace with point-at-eol.
+
+ * flow-fill.el (fill-flowed-point-at-bol,
+ fill-flowed-point-at-eol): Replace with point-at-{eol,bol}.
+
+ * gnus-util.el (gnus-point-at-bol, gnus-point-at-eol): Remove.
+ Replace with point-at-{eol,bol} throughout all files.
+
2004-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
* ntlm.el (ntlm-string-as-unibyte): New macro.
(push (file-name-as-directory path) adds)))
(setq load-path (nconc (nreverse adds) load-path))))
-(load (expand-file-name "dgnuspath.el" srcdir) nil nil t)
+(if (file-exists-p (expand-file-name "dgnuspath.el" srcdir))
+ (load (expand-file-name "dgnuspath.el" srcdir) nil nil t)
+ (message " ** There's no dgnuspath.el file"))
(condition-case err
(load "~/.lpath.el" t nil t)
(push srcdir load-path)
(load (expand-file-name "lpath.el" srcdir) nil t t)
-(load (expand-file-name "gnus-clfns.el" srcdir) nil t t)
-
(require 'custom)
;; Bind functions defined by `defun-maybe'.
(eval-and-compile
(when (featurep 'xemacs)
- ;; XEmacs 21.1 needs some extra hand holding
- (when (eq emacs-minor-version 1)
- (autoload 'custom-declare-face "cus-face" nil t)
- (autoload 'cl-compile-time-init "cl-macs" nil t)
- (autoload 'defadvice "advice" nil nil 'macro))
(unless (fboundp 'defadvice)
(autoload 'defadvice "advice" nil nil 'macro))
(autoload 'Info-directory "info" nil t)
(autoload 'delete-annotation "annotations")
(autoload 'dolist "cl-macs" nil nil 'macro)
(autoload 'enriched-decode "enriched")
+ (autoload 'executable-find "executable")
(autoload 'info "info" nil t)
(autoload 'make-annotation "annotations")
(autoload 'make-display-table "disp-table")
""))
'("gnus-bbdb.el")))
(unless (featurep 'xemacs)
- '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el"))
+ '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el"
+ "run-at-time.el"))
(when (and (fboundp 'base64-decode-string)
(subrp (symbol-function 'base64-decode-string)))
'("base64.el"))
(if (featurep 'xemacs)
`(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
- (gnus-xmas-open-network-stream "dns" (current-buffer)
- ,server "domain" 'udp))
+ (open-network-stream "dns" (current-buffer)
+ ,server "domain" 'udp))
`(let ((server ,server)
(coding-system-for-read 'binary)
(coding-system-for-write 'binary)
(sexp)
(integer)))
-(eval-and-compile
- (defalias 'fill-flowed-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
-
- (defalias 'fill-flowed-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
;;;###autoload
(defun fill-flowed-encode (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
(let ((fill-prefix (when quote (concat quote " ")))
(fill-column (eval fill-flowed-display-column))
filladapt-mode)
- (fill-region (fill-flowed-point-at-bol)
- (min (1+ (fill-flowed-point-at-eol))
+ (fill-region (point-at-bol)
+ (min (1+ (point-at-eol))
(point-max))
'left 'nosqueeze))
(error
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'gnus)
(require 'gnus-cache)
(gnus-message 1
"Overview buffer contains garbage '%s'."
(buffer-substring
- p (gnus-point-at-eol))))
+ p (point-at-eol))))
((= cur prev-num)
(or backed-up
(setq backed-up (gnus-agent-backup-overview-buffer)))
(gnus-category-position-point)))
(defun gnus-category-name ()
- (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category))
+ (or (intern (get-text-property (point-at-bol) 'gnus-category))
(error "No category on the current line")))
(defun gnus-category-read ()
(incf (nth 0 stats))
- (let ((from (gnus-point-at-bol))
+ (let ((from (point-at-bol))
(to (progn (forward-line 1) (point))))
(incf (nth 2 stats) (- to from))
(delete-region from to)))
(autoload 'gnus-msg-mail "gnus-msg" nil t)
(autoload 'gnus-button-mailto "gnus-msg")
(autoload 'gnus-button-reply "gnus-msg" nil t)
+(autoload 'ansi-color-apply-on-region "ansi-color")
(defgroup gnus-article nil
"Article display."
:type gnus-article-treat-custom)
(put 'gnus-treat-overstrike 'highlight t)
+(defcustom gnus-treat-ansi-sequences t
+ "Treat ANSI SGR control sequences.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
(make-obsolete-variable 'gnus-treat-display-xface
'gnus-treat-display-x-face)
(gnus-treat-strip-multiple-blank-lines
gnus-article-strip-multiple-blank-lines)
(gnus-treat-overstrike gnus-article-treat-overstrike)
+ (gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences)
(gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
(gnus-treat-fold-headers gnus-article-treat-fold-headers)
;; Displaying X-Face should be done after unfolding headers
(while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
(forward-line -1)
(gnus-article-hide-text-type
- (gnus-point-at-bol)
+ (point-at-bol)
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(goto-char (point-min))
(when (re-search-forward (concat "^" header ":") nil t)
(gnus-article-hide-text-type
- (gnus-point-at-bol)
+ (point-at-bol)
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(article-narrow-to-head)
(while (not (eobp))
(cond
- ((< (setq column (- (gnus-point-at-eol) (point)))
+ ((< (setq column (- (point-at-eol) (point)))
gnus-article-normalized-header-length)
(end-of-line)
(insert (make-string
(progn
(forward-char gnus-article-normalized-header-length)
(point))
- (gnus-point-at-eol)
+ (point-at-eol)
'invisible t))
(t
;; Do nothing.
(put-text-property
(point) end 'face 'underline)))))))))
+(defun article-treat-ansi-sequences ()
+ "Translate ANSI SGR control sequences into overlays or extents."
+ (interactive)
+ (save-excursion
+ (when (article-goto-body)
+ (let ((buffer-read-only nil))
+ (ansi-color-apply-on-region (point) (point-max))))))
+
(defun gnus-article-treat-unfold-headers ()
"Unfold folded message headers.
Only the headers that fit into the current window width will be
(end-of-line)
(when (>= (current-column) (min fill-column width))
(narrow-to-region (min (1+ (point)) (point-max))
- (gnus-point-at-bol))
+ (point-at-bol))
(let ((goback (point-marker)))
(fill-paragraph nil)
(goto-char (marker-position goback)))
(while (and (not (bobp))
(looking-at "^[ \t]*$")
(not (gnus-annotation-in-region-p
- (point) (gnus-point-at-eol))))
+ (point) (point-at-eol))))
(forward-line -1))
(forward-line 1)
(point))))))
(re-search-forward "^Date:[ \t]" nil t)
;; If Date is missing, try again for X-Sent.
(re-search-forward "^X-Sent:[ \t]" nil t))
- (setq bface (get-text-property (gnus-point-at-bol) 'face)
- date (or (get-text-property (gnus-point-at-bol)
+ (setq bface (get-text-property (point-at-bol) 'face)
+ date (or (get-text-property (point-at-bol)
'original-date)
date)
- eface (get-text-property (1- (gnus-point-at-eol))
+ eface (get-text-property (1- (point-at-eol))
'face)))
(let ((buffer-read-only nil))
;; Delete any old X-Sent headers.
(goto-char (point-min)))
(insert (article-make-date-line date type))
(when (eq type 'lapsed)
- (put-text-property (gnus-point-at-bol) (point)
+ (put-text-property (point-at-bol) (point)
'article-date-lapsed t))
(insert "\n")
(forward-line -1)
(setq n 1))
(gnus-stop-date-timer)
(setq article-lapsed-timer
- (nnheader-run-at-time 1 n 'article-update-date-lapsed)))
+ (run-at-time 1 n 'article-update-date-lapsed)))
(defun gnus-stop-date-timer ()
"Stop the X-Sent timer."
(shell-command-on-region (point-min) (point-max) command nil)))
(setq gnus-last-shell-command command))
-(defmacro gnus-read-string (prompt &optional initial-contents history
- default-value)
- "Like `read-string' but allow for older XEmacsen that don't have the 5th arg."
- (if (and (featurep 'xemacs)
- (< emacs-minor-version 2))
- `(read-string ,prompt ,initial-contents ,history)
- `(read-string ,prompt ,initial-contents ,history ,default-value)))
-
(defun gnus-summary-pipe-to-muttprint (&optional command)
"Pipe this article to muttprint."
- (setq command (gnus-read-string
+ (setq command (read-string
"Print using command: " gnus-summary-muttprint-program
nil gnus-summary-muttprint-program))
(gnus-summary-save-in-pipe command))
(message-narrow-to-head)
(goto-char (point-max))
(forward-line -1)
- (setq bface (get-text-property (gnus-point-at-bol) 'face)
- eface (get-text-property (1- (gnus-point-at-eol)) 'face))
+ (setq bface (get-text-property (point-at-bol) 'face)
+ eface (get-text-property (1- (point-at-eol)) 'face))
(message-remove-header "X-Gnus-PGP-Verify")
(if (re-search-forward "^X-PGP-Sig:" nil t)
(forward-line)
article-monafy
article-hide-boring-headers
article-treat-overstrike
+ article-treat-ansi-sequences
article-fill-long-lines
article-capitalize-sentences
article-remove-cr
["Hide signature" gnus-article-hide-signature t]
["Hide citation" gnus-article-hide-citation t]
["Treat overstrike" gnus-article-treat-overstrike t]
+ ["Treat ANSI sequences" gnus-article-treat-ansi-sequences t]
["Remove carriage return" gnus-article-remove-cr t]
["Remove leading whitespace" gnus-article-remove-leading-whitespace t]
["Treat html" gnus-article-wash-html t]
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
- `(,@(gnus-local-map-property gnus-mime-button-map)
- gnus-callback gnus-mm-display-part
- gnus-part ,gnus-tmp-id
- article-type annotation
- gnus-data ,handle))
+ `(keymap ,gnus-mime-button-map
+ gnus-callback gnus-mm-display-part
+ gnus-part ,gnus-tmp-id
+ article-type annotation
+ gnus-data ,handle))
(setq e (if (bolp)
;; Exclude a newline.
(1- (point))
',gnus-article-mime-handle-alist))
(gnus-mime-display-alternative
',ihandles ',not-pref ',begend ,id))
- ,@(gnus-local-map-property gnus-mime-button-map)
+ keymap ,gnus-mime-button-map
,gnus-mouse-face-prop ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
',gnus-article-mime-handle-alist))
(gnus-mime-display-alternative
',ihandles ',handle ',begend ,id))
- ,@(gnus-local-map-property gnus-mime-button-map)
+ keymap ,gnus-mime-button-map
,gnus-mouse-face-prop ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
"Read article specified by message-id around point."
(interactive)
(save-excursion
- (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
- (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
- (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
+ (re-search-backward "[ \t]\\|^" (point-at-bol) t)
+ (re-search-forward "<?news:<?\\|<" (point-at-eol) t)
+ (if (re-search-forward "[^@ ]+@[^ \t>]+" (point-at-eol) t)
(let ((msg-id (concat "<" (match-string 0) ">")))
(set-buffer gnus-summary-buffer)
(gnus-summary-refer-article msg-id))
(car gnus-article-current) (cdr gnus-article-current)))
;; We remove all text props from the article buffer.
(kill-all-local-variables)
- (gnus-set-text-properties (point-min) (point-max) nil)
+ (set-text-properties (point-min) (point-max) nil)
(gnus-article-mode)
(set-window-configuration winconf)
(set-buffer buf)
(fun (nth 3 entry))
(args (mapcar (lambda (group)
(let ((string (match-string group)))
- (gnus-set-text-properties
+ (set-text-properties
0 (length string) nil string)
string))
(nthcdr 4 entry))))
(situation (get-text-property (point-min) 'mime-view-situation)))
(gnus-eval-format
gnus-prev-page-line-format nil
- `(,@(gnus-local-map-property gnus-prev-page-map)
+ `(keymap ,gnus-prev-page-map
gnus-prev t
gnus-callback gnus-article-button-prev-page
article-type annotation
(buffer-read-only nil)
(situation (get-text-property (point-min) 'mime-view-situation)))
(gnus-eval-format gnus-next-page-line-format nil
- `(,@(gnus-local-map-property gnus-next-page-map)
+ `(keymap ,gnus-next-page-map
gnus-next t
gnus-callback gnus-article-button-next-page
article-type annotation
(gnus-eval-format
gnus-mime-security-button-line-format
gnus-mime-security-button-line-format-alist
- `(,@(gnus-local-map-property gnus-mime-security-button-map)
+ `(keymap ,gnus-mime-security-button-map
gnus-callback gnus-mime-security-press-button
gnus-line-format ,gnus-mime-security-button-line-format
gnus-mime-details ,gnus-mime-security-button-pressed
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'gnus)
(require 'gnus-int)
(set-buffer cache-buf)
(if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
nil t)
- (setq beg (gnus-point-at-bol)
+ (setq beg (point-at-bol)
end (progn (end-of-line) (point)))
(setq beg nil))
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(forward-line (1- number))
(when (re-search-forward gnus-cite-attribution-suffix
- (gnus-point-at-eol)
+ (point-at-eol)
t)
(gnus-article-add-button (match-beginning 1) (match-end 1)
'gnus-cite-toggle prefix))
;; Each line.
(setq begin (point)
guess-limit (progn (skip-chars-forward "^> \t\r\n") (point))
- end (gnus-point-at-bol 2)
+ end (point-at-bol 2)
start end)
(goto-char begin)
;; Ignore standard Supercite attribution prefix.
;; Each prefix.
(setq end (match-end 0)
prefix (buffer-substring begin end))
- (gnus-set-text-properties 0 (length prefix) nil prefix)
+ (set-text-properties 0 (length prefix) nil prefix)
(setq entry (assoc prefix alist))
(if entry
(setcdr entry (cons line (cdr entry)))
+++ /dev/null
-;;; gnus-clfns.el --- compiler macros for emulating cl functions
-
-;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
-
-;; Author: Kastsumi Yamaoka <yamaoka@jpl.org>
-;; Keywords: cl, compile
-
-;; 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 2, 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This module is for mainly avoiding cl runtime functions in FSF
-;; Emacsen. Function should also be defined as an ordinary function
-;; if it will not be provided in cl.
-
-;;; Code:
-
-(if (featurep 'xemacs)
- nil
- (eval-when-compile (require 'cl))
- (require 'pym)
-
- (define-compiler-macro butlast (&whole form x &optional n)
- (if (>= emacs-major-version 21)
- form
- (if n
- `(let ((x ,x)
- (n ,n))
- (if (and n (<= n 0))
- x
- (let ((m (length x)))
- (or n (setq n 1))
- (and (< n m)
- (progn
- (if (> n 0)
- (progn
- (setq x (copy-sequence x))
- (setcdr (nthcdr (- (1- m) n) x) nil)))
- x)))))
- `(let* ((x ,x)
- (m (length x)))
- (and (< 1 m)
- (progn
- (setq x (copy-sequence x))
- (setcdr (nthcdr (- m 2) x) nil)
- x))))))
-
-;; (define-compiler-macro coerce (&whole form x type)
-;; (if (and (fboundp 'coerce)
-;; (subrp (symbol-function 'coerce)))
-;; form
-;; `(let ((x ,x)
-;; (type ,type))
-;; (cond ((eq type 'list) (if (listp x) x (append x nil)))
-;; ((eq type 'vector) (if (vectorp x) x (vconcat x)))
-;; ((eq type 'string) (if (stringp x) x (concat x)))
-;; ((eq type 'array) (if (arrayp x) x (vconcat x)))
-;; ((and (eq type 'character) (stringp x) (= (length x) 1))
-;; (aref x 0))
-;; ((and (eq type 'character) (symbolp x)
-;; (= (length (symbol-name x)) 1))
-;; (aref (symbol-name x) 0))
-;; ((eq type 'float) (float x))
-;; ((typep x type) x)
-;; (t (error "Can't coerce %s to type %s" x type))))))
-
-;; (define-compiler-macro copy-list (&whole form list)
-;; (if (and (fboundp 'copy-list)
-;; (subrp (symbol-function 'copy-list)))
-;; form
-;; `(let ((list ,list))
-;; (if (consp list)
-;; (let ((res nil))
-;; (while (consp list) (push (pop list) res))
-;; (prog1 (nreverse res) (setcdr res list)))
-;; (car list)))))
-
- (define-compiler-macro last (&whole form x &optional n)
- (if (>= emacs-major-version 20)
- form
- (if n
- `(let* ((x ,x)
- (n ,n)
- (m 0)
- (p x))
- (while (consp p)
- (incf m)
- (pop p))
- (if (<= n 0)
- p
- (if (< n m)
- (nthcdr (- m n) x)
- x)))
- `(let ((x ,x))
- (while (consp (cdr x))
- (pop x))
- x))))
-
- (define-compiler-macro mapc (&whole form fn seq &rest rest)
- (if (>= emacs-major-version 21)
- form
- (if rest
- `(let* ((fn ,fn)
- (seq ,seq)
- (args (list seq ,@rest))
- (m (apply (function min) (mapcar (function length) args)))
- (n 0))
- (while (< n m)
- (apply fn (mapcar (function (lambda (arg) (nth n arg))) args))
- (setq n (1+ n)))
- seq)
- `(let ((seq ,seq))
- (mapcar ,fn seq)
- seq))))
-
-;; (define-compiler-macro merge (&whole form type seq1 seq2 pred &rest keys)
-;; (if (and (fboundp 'merge)
-;; (subrp (symbol-function 'merge)))
-;; form
-;; `(let ((type ,type)
-;; (seq1 ,seq1)
-;; (seq2 ,seq2)
-;; (pred ,pred))
-;; (or (listp seq1) (setq seq1 (append seq1 nil)))
-;; (or (listp seq2) (setq seq2 (append seq2 nil)))
-;; (let ((res nil))
-;; (while (and seq1 seq2)
-;; (if (funcall pred (car seq2) (car seq1))
-;; (push (pop seq2) res)
-;; (push (pop seq1) res)))
-;; (coerce (nconc (nreverse res) seq1 seq2) type)))))
-
-;; (define-compiler-macro string (&whole form &rest args)
-;; (if (>= emacs-major-version 20)
-;; form
-;; (list 'concat (cons 'list args))))
-
-;; (defun-maybe string (&rest args)
-;; "Concatenate all the argument characters and make the result a string."
-;; (concat args))
-
- (define-compiler-macro string-to-list (&whole form string)
- (cond ((fboundp 'string-to-list)
- form)
- ((fboundp 'string-to-char-list)
- (list 'string-to-char-list string))
- (t
- `(let* ((str ,string)
- (len (length str))
- (idx 0)
- c l)
- (while (< idx len)
- (setq c (sref str idx))
- (setq idx (+ idx (char-bytes c)))
- (setq l (cons c l)))
- (nreverse l)))))
-
- ;; 92.7.2 by K.Handa (imported from Mule 2.3)
- (defun-maybe string-to-list (str)
- (let ((len (length str))
- (idx 0)
- c l)
- (while (< idx len)
- (setq c (sref str idx))
- (setq idx (+ idx (char-bytes c)))
- (setq l (cons c l)))
- (nreverse l)))
-
-;; (define-compiler-macro subseq (&whole form seq start &optional end)
-;; (if (and (fboundp 'subseq)
-;; (subrp (symbol-function 'subseq)))
-;; form
-;; (if end
-;; `(let ((seq ,seq)
-;; (start ,start)
-;; (end ,end))
-;; (if (stringp seq)
-;; (substring seq start end)
-;; (let (len)
-;; (if (< end 0)
-;; (setq end (+ end (setq len (length seq)))))
-;; (if (< start 0)
-;; (setq start (+ start (or len (setq len (length seq))))))
-;; (cond ((listp seq)
-;; (if (> start 0)
-;; (setq seq (nthcdr start seq)))
-;; (let ((res nil))
-;; (while (>= (setq end (1- end)) start)
-;; (push (pop seq) res))
-;; (nreverse res)))
-;; (t
-;; (let ((res (make-vector (max (- end start) 0) nil))
-;; (i 0))
-;; (while (< start end)
-;; (aset res i (aref seq start))
-;; (setq i (1+ i)
-;; start (1+ start)))
-;; res))))))
-;; `(let ((seq ,seq)
-;; (start ,start))
-;; (if (stringp seq)
-;; (substring seq start)
-;; (let (len)
-;; (if (< start 0)
-;; (setq start (+ start (or len (setq len (length seq))))))
-;; (cond ((listp seq)
-;; (if (> start 0)
-;; (setq seq (nthcdr start seq)))
-;; (copy-sequence seq))
-;; (t
-;; (let* ((end (or len (length seq)))
-;; (res (make-vector (max (- end start) 0) nil))
-;; (i 0))
-;; (while (< start end)
-;; (aset res i (aref seq start))
-;; (setq i (1+ i)
-;; start (1+ start)))
-;; res)))))))))
- )
-
-;; A tool for the developers.
-
-(defvar cl-run-time-functions
- '(Values
- Values-list acons assoc-if assoc-if-not build-klist butlast ceiling*
- coerce common-lisp-indent-function compiler-macroexpand concatenate
- copy-list count count-if count-if-not delete* delete-duplicates delete-if
- delete-if-not duplicate-symbols-p elt-satisfies-test-p equalp evenp every
- extract-from-klist fill find find-if find-if-not floatp-safe floor* gcd
- gensym gentemp get-setf-method getf hash-table-count hash-table-p
- intersection isqrt keyword-argument-supplied-p keyword-of keywordp last
- lcm ldiff lisp-indent-259 lisp-indent-do lisp-indent-function-lambda-hack
- lisp-indent-report-bad-format lisp-indent-tagbody list-length
- make-hash-table make-random-state map mapc mapcan mapcar* mapcon mapl
- maplist member-if member-if-not merge mismatch mod* nbutlast nintersection
- notany notevery nreconc nset-difference nset-exclusive-or nsublis nsubst
- nsubst-if nsubst-if-not nsubstitute nsubstitute-if nsubstitute-if-not
- nunion oddp pair-with-newsyms pairlis position position-if position-if-not
- proclaim random* random-state-p rassoc* rassoc-if rassoc-if-not
- reassemble-argslists reduce rem* remove remove* remove-duplicates
- remove-if remove-if-not remq replace revappend round* safe-idiv search
- set-difference set-exclusive-or setelt setnth setnthcdr signum some sort*
- stable-sort sublis subseq subsetp subst subst-if subst-if-not substitute
- substitute-if substitute-if-not tailp tree-equal truncate* union
- unzip-lists zip-lists)
- "A list of CL run-time functions. Some functions were built-in, nowadays.")
-
-;;;###autoload
-(defun find-cl-run-time-functions (file-or-directory arg)
- "Find CL run-time functions in the FILE-OR-DIRECTORY. You can alter
-the behavior of this command with the prefix ARG as described below.
-
-By default, it searches for all the CL run-time functions listed in
- the variable `cl-run-time-functions'.
-With 1 or 3 \\[universal-argument]'s, the built-in functions in this Emacs\
- will not be
- reported.
-With 2 or 3 \\[universal-argument]'s, just the symbols will also be reported.
-
-You can use the `digit-argument' 1, 2 or 3 instead of\
- \\[universal-argument]'s."
- (interactive (list (read-file-name "Find CL run-time functions in: "
- nil default-directory t)
- current-prefix-arg))
- (unless (interactive-p)
- (error "You should invoke `M-x find-cl-run-time-functions' interactively"))
- (let ((report-symbols (member arg '((16) (64) 2 3)))
- files clfns working file lines form forms fns fn newform buffer
- window scroll
- buffer-file-format format-alist
- insert-file-contents-post-hook insert-file-contents-pre-hook)
- (cond ((file-directory-p file-or-directory)
- (setq files (directory-files file-or-directory t "\\.el$"))
- (dolist (file files)
- (unless (file-exists-p file)
- (setq files (delete file files))))
- (unless files
- (message "No files found in: %s" file-or-directory))
- files)
- ((file-exists-p file-or-directory)
- (setq files (list file-or-directory)))
- (t
- (message "No such file or directory: %s" file-or-directory)))
- (when files
- (if (member arg '((4) (64) 1 3))
- (dolist (fn cl-run-time-functions)
- (unless (and (fboundp fn)
- (subrp (symbol-function fn)))
- (push fn clfns)))
- (setq clfns cl-run-time-functions))
- (set-buffer (setq working
- (get-buffer-create
- " *Searching for CL run-time functions*")))
- (let (emacs-lisp-mode-hook)
- (emacs-lisp-mode))
- (while files
- (setq file (pop files)
- lines (list nil nil))
- (message "Searching for CL run-time functions in: %s..."
- (file-name-nondirectory file))
- (insert-file-contents file nil nil nil t)
- ;; XEmacs moves point to the beginning of the buffer after
- ;; inserting a file, FSFmacs doesn't so if the fifth argument
- ;; of `insert-file-contents' is specified.
- (goto-char (point-min))
- ;;
- (while (progn
- (while (and (looking-at "[\t\v\f\r ]*\\(;.*\\)?$")
- (zerop (forward-line 1))))
- (not (eobp)))
- (setcar lines (if (bolp)
- (1+ (count-lines (point-min) (point)))
- (count-lines (point-min) (point))))
- (when (consp;; Ignore stand-alone symbols, strings, etc.
- (setq form (condition-case nil
- (read working)
- (error nil))))
- (setcdr lines (list (count-lines (point-min) (point))))
- (setq forms (list form)
- fns nil)
- (while forms
- (setq form (pop forms))
- (when (consp form)
- (setq fn (pop form))
- (cond ((memq fn '(apply mapatoms mapcar mapconcat
- mapextent symbol-function))
- (if (consp (car form))
- (when (memq (caar form) '(\` backquote quote))
- (setcar form (cdar form)))
- (setq form (cdr form))))
- ((memq fn '(\` backquote quote))
- (if report-symbols
- (progn
- (setq form (car form)
- newform nil)
- (while form
- (push (list (or (car-safe form) form))
- newform)
- (setq form (cdr-safe form)))
- (setq form (nreverse newform)))
- (setq form nil)))
- ((memq fn '(defadvice
- defmacro defsubst defun
- defmacro-maybe defmacro-maybe-cond
- defsubst-maybe defun-maybe
- defun-maybe-cond))
- (setq form (cddr form)))
- ((memq fn '(defalias lambda fset))
- (setq form (cdr form)))
- ((eq fn 'define-compiler-macro)
- (setq form nil))
- ((eq fn 'dolist)
- (setcar form (cadar form)))
- ((memq fn '(let let*))
- (setq form
- (append
- (delq nil
- (mapcar
- (lambda (element)
- (when (and (consp element)
- (consp (cadr element)))
- (cadr element)))
- (car form)))
- (cdr form))))
- ((eq fn 'sort)
- (when (and (consp (cadr form))
- (memq (caadr form) '(\` backquote quote)))
- (setcdr form (list (cdadr form)))))
- ((and (memq fn clfns)
- (listp form))
- (push fn fns)))
- (when (listp form)
- (setq forms (append form forms)))))
- (when fns
- (if buffer
- (set-buffer buffer)
- (display-buffer
- (setq buffer (get-buffer-create
- (concat "*CL run-time functions in: "
- file-or-directory "*"))))
- (set-buffer buffer)
- (erase-buffer)
- (setq window (get-buffer-window buffer t)
- scroll (- 2 (window-height window))
- fill-column (max 16 (- (window-width window) 2))
- fill-prefix " "))
- (when file
- (insert file "\n")
- (setq file nil))
- (narrow-to-region
- (point)
- (progn
- (insert fill-prefix
- (mapconcat (lambda (fn) (format "%s" fn))
- (nreverse fns) " ")
- "\n")
- (point)))
- (fill-region (point-min) (point-max))
- (goto-char (point-min))
- (widen)
- (delete-char 14)
- (insert (format "%5d - %5d:" (car lines) (cadr lines)))
- (goto-char (point-max))
- (forward-line scroll)
- (set-window-start window (point))
- (goto-char (point-max))
- (sit-for 0)
- (set-buffer working)))))
- (kill-buffer working)
- (if buffer
- (message "Done")
- (message "No CL run-time functions found in: %s"
- file-or-directory)))))
-
-(provide 'gnus-clfns)
-
-;;; gnus-clfns.el ends here
(when gnus-demon-handlers
;; Set up the timer.
(setq gnus-demon-timer
- (nnheader-run-at-time
+ (run-at-time
gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
;; Reset control variables.
(setq gnus-demon-handler-state
(when (re-search-forward (concat "^" header ":") nil t)
(unless (eq (char-after) ? )
(insert " "))
- (setq value (buffer-substring (point) (gnus-point-at-eol)))
+ (setq value (buffer-substring (point) (point-at-eol)))
(and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value)
(setq value (match-string 1 value)))
(condition-case ()
(if (null arg) (not gnus-dired-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-dired-mode
- (gnus-add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map)
+ (add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map)
(gnus-run-hooks 'gnus-dired-mode-hook))))
;;;###autoload
;; Set up the menu.
(when (gnus-visual-p 'draft-menu 'menu)
(gnus-draft-make-menu-bar))
- (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map)
+ (add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map)
(gnus-run-hooks 'gnus-draft-mode-hook))))
;;; Commands
(concat "^" (regexp-quote gnus-agent-target-move-group-header)
":") nil t)
(skip-syntax-forward "-")
- (setq move-to (buffer-substring (point) (gnus-point-at-eol)))
+ (setq move-to (buffer-substring (point) (point-at-eol)))
(message-remove-header gnus-agent-target-move-group-header))
(goto-char (point-min))
(when (re-search-forward
(defvar gnus-down-mouse-2 [down-mouse-2])
(defvar gnus-widget-button-keymap nil)
(defvar gnus-mode-line-modified
- (if (or (featurep 'xemacs)
- (< emacs-major-version 20))
+ (if (featurep 'xemacs)
'("--**-" . "-----")
'("**" "--")))
;;; Mule functions.
(eval-and-compile
- (defalias 'gnus-char-width
- (if (fboundp 'char-width)
- 'char-width
- (lambda (ch) 1)))) ;; A simple hack.
-
-(eval-and-compile
(if (featurep 'xemacs)
(gnus-xmas-define)
(defvar gnus-mouse-face-prop 'mouse-face
"Non-nil means the mark and region are currently active in this buffer."
mark-active) ; aliased to region-exists-p in XEmacs.
-(if (fboundp 'add-minor-mode)
- (defalias 'gnus-add-minor-mode 'add-minor-mode)
- (defun gnus-add-minor-mode (mode name map &rest rest)
- (set (make-local-variable mode) t)
- (unless (assq mode minor-mode-alist)
- (push `(,mode ,name) minor-mode-alist))
- (unless (assq mode minor-mode-map-alist)
- (push (cons mode map)
- minor-mode-map-alist))))
-
(defun gnus-x-splash ()
"Show a splash screen using a pixmap in the current buffer."
(let ((dir (nnheader-find-etc-directory "gnus"))
(when (and menu-bar-mode
(gnus-visual-p 'grouplens-menu 'menu))
(gnus-grouplens-make-menu-bar))
- (gnus-add-minor-mode
+ (add-minor-mode
'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map)
(gnus-run-hooks 'gnus-grouplens-mode-hook))))
(gnus-group-setup-buffer)
(gnus-update-format-specifications nil 'group 'group-mode)
(let ((case-fold-search nil)
- (props (text-properties-at (gnus-point-at-bol)))
+ (props (text-properties-at (point-at-bol)))
(empty (= (point-min) (point-max)))
(group (gnus-group-group-name))
number)
"Highlight the current line according to `gnus-group-highlight'."
(let* ((list gnus-group-highlight)
(p (point))
- (end (gnus-point-at-eol))
+ (end (point-at-eol))
;; now find out where the line starts and leave point there.
(beg (progn (beginning-of-line) (point)))
(group (gnus-group-group-name))
(defun gnus-group-group-name ()
"Get the name of the newsgroup on the current line."
- (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
+ (let ((group (get-text-property (point-at-bol) 'gnus-group)))
(when group
(symbol-name group))))
(defun gnus-group-group-level ()
"Get the level of the newsgroup on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-level))
+ (get-text-property (point-at-bol) 'gnus-level))
(defun gnus-group-group-indentation ()
"Get the indentation of the newsgroup on the current line."
- (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
+ (or (get-text-property (point-at-bol) 'gnus-indentation)
(and gnus-group-indentation-function
(funcall gnus-group-indentation-function))
""))
(defun gnus-group-group-unread ()
"Get the number of unread articles of the newsgroup on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-unread))
+ (get-text-property (point-at-bol) 'gnus-unread))
(defun gnus-group-new-mail (group)
(if (nnmail-new-mail-p (gnus-group-real-name group))
;; Set up the menu.
(when (gnus-visual-p 'mailing-list-menu 'menu)
(gnus-mailing-list-make-menu-bar))
- (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" gnus-mailing-list-mode-map)
+ (add-minor-mode 'gnus-mailing-list-mode " Mailing-List" gnus-mailing-list-mode-map)
(gnus-run-hooks 'gnus-mailing-list-mode-hook))))
;;; Commands
;;; gnus-namazu.el --- Search mail with Namazu -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2000,2001,2002,2003 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004
+;; TSUCHIYA Masatoshi <tsuchiya@namazu.org>
;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
;; Keywords: mail searching namazu
(replace-match "\\1:/"))
(eq ?~ (char-after (point))))
(insert (expand-file-name
- (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))))
- (delete-region (point) (gnus-point-at-eol)))
+ (buffer-substring (point-at-bol) (point-at-eol))))
+ (delete-region (point) (point-at-eol)))
(forward-line 1)))
(defsubst gnus-namazu/call-namazu (query)
group
(string-to-number
(buffer-substring-no-properties (point)
- (gnus-point-at-eol))))
+ (point-at-eol))))
articles))
(forward-line 1))
(nreverse articles))))
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'gnus)
(require 'nnmail)
:type '(radio (const :format "Unlimited " nil)
(integer :format "Maximum number: %v\n" :size 0)))
-;; Function(s) missing in Emacs 20
-(when (memq nil (mapcar 'fboundp '(puthash)))
- (require 'cl)
- (unless (fboundp 'puthash)
- ;; alias puthash is missing from Emacs 20 cl-extra.el
- (defalias 'puthash 'cl-puthash)))
-
(defun gnus-registry-track-subject-p ()
(memq 'subject gnus-registry-track-extra))
;; Set up the menu.
(when (gnus-visual-p 'pick-menu 'menu)
(gnus-pick-make-menu-bar))
- (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map
+ (add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map
nil 'gnus-pick-mode)
(gnus-run-hooks 'gnus-pick-mode-hook))))
;; Set up the menu.
(when (gnus-visual-p 'binary-menu 'menu)
(gnus-binary-make-menu-bar))
- (gnus-add-minor-mode 'gnus-binary-mode " Binary"
+ (add-minor-mode 'gnus-binary-mode " Binary"
gnus-binary-mode-map nil 'gnus-binary-mode)
(gnus-run-hooks 'gnus-binary-mode-hook))))
(unless (zerop level)
(gnus-tree-indent level)
(insert (cadr gnus-tree-parent-child-edges))
- (setq col (- (setq beg (point)) (gnus-point-at-bol) 1))
+ (setq col (- (setq beg (point)) (point-at-bol) 1))
;; Draw "|" lines upwards.
(while (progn
(forward-line -1)
(defsubst gnus-tree-indent-vertical ()
(let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent)
- (- (point) (gnus-point-at-bol)))))
+ (- (point) (point-at-bol)))))
(when (> len 0)
(insert (make-string len ? )))))
(setq button (car buttons)
buttons (cdr buttons))
(if (stringp button)
- (gnus-set-text-properties
+ (set-text-properties
(point)
(prog2 (insert button) (point) (insert " "))
(list 'face gnus-carpal-header-face))
- (gnus-set-text-properties
+ (set-text-properties
(point)
(prog2 (insert (car button)) (point) (insert " "))
(list 'gnus-callback (cdr button)
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'gnus)
(require 'gnus-sum)
(reg " -> +")
(file (save-excursion
(end-of-line)
- (if (and (re-search-backward reg (gnus-point-at-bol) t)
- (re-search-forward reg (gnus-point-at-eol) t))
- (buffer-substring (point) (gnus-point-at-eol))
+ (if (and (re-search-backward reg (point-at-bol) t)
+ (re-search-forward reg (point-at-eol) t))
+ (buffer-substring (point) (point-at-eol))
nil))))
(if (or (not file)
(string-match "\\<\\(non-file rule\\|A file\\)\\>" file)
(goto-char (point-min))
(if (= dmt ?e)
(while (funcall search-func match nil t)
- (and (= (gnus-point-at-bol)
+ (and (= (point-at-bol)
(match-beginning 0))
(= (progn (end-of-line) (point))
(match-end 0))
(funcall search-func match nil t))
;; Is it really exact?
(and (eolp)
- (= (gnus-point-at-bol) (match-beginning 0))
+ (= (point-at-bol) (match-beginning 0))
;; Yup.
(progn
(setq found (setq arts (get-text-property
(goto-char (point-min))
(while (and (not (eobp))
(search-forward match nil t))
- (when (and (= (gnus-point-at-bol) (match-beginning 0))
+ (when (and (= (point-at-bol) (match-beginning 0))
(eolp))
(setq found (setq arts (get-text-property (point) 'articles)))
(if trace
hashtb))
(gnus-sethash
word
- (append (get-text-property (gnus-point-at-eol) 'articles) val)
+ (append (get-text-property (point-at-eol) 'articles) val)
hashtb)))
(set-syntax-table syntab))
;; Make all the ignorable words ignored.
(defun gnus-correct-length (string)
"Return the correct width of STRING."
(let ((length 0))
- (mapcar (lambda (char) (incf length (gnus-char-width char))) string)
+ (mapcar (lambda (char) (incf length (char-width char))) string)
length))
(defun gnus-correct-substring (string start &optional end)
;; Find the start position.
(while (and (< seek length)
(< wseek start))
- (incf wseek (gnus-char-width (aref string seek)))
+ (incf wseek (char-width (aref string seek)))
(incf seek))
(setq wstart seek)
;; Find the end position.
(while (and (<= seek length)
(or (not end)
(<= wseek end)))
- (incf wseek (gnus-char-width (aref string seek)))
+ (incf wseek (char-width (aref string seek)))
(incf seek))
(setq wend seek)
(substring string wstart (1- wend))))
(gnus-server-position-point))
(defun gnus-server-server-name ()
- (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server)))
+ (let ((server (get-text-property (point-at-bol) 'gnus-server)))
(and server (symbol-name server))))
(defun gnus-server-named-server ()
"Returns a server name that matches one of the names returned by
gnus-method-to-server."
- (let ((server (get-text-property (gnus-point-at-bol) 'gnus-named-server)))
+ (let ((server (get-text-property (point-at-bol) 'gnus-named-server)))
(and server (symbol-name server))))
(defalias 'gnus-server-position-point 'gnus-goto-colon)
(save-excursion
(beginning-of-line)
(let ((name (get-text-property (point) 'gnus-group)))
- (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
+ (when (re-search-forward ": \\(.*\\)$" (point-at-eol) t)
(concat (gnus-method-to-server-name gnus-browse-current-method) ":"
(or name
(match-string-no-properties 1)))))))
(while (not (eobp))
(condition-case ()
(progn
- (narrow-to-region (point) (gnus-point-at-eol))
+ (narrow-to-region (point) (point-at-eol))
;; group gets set to a symbol interned in the hash table
;; (what a hack!!) - jwz
(setq group (let ((obarray hashtb)) (read cur)))
(unless ignore-errors
(gnus-message 3 "Warning - invalid active: %s"
(buffer-substring
- (gnus-point-at-bol) (gnus-point-at-eol))))))
+ (point-at-bol) (point-at-eol))))))
(widen)
(forward-line 1)))))
;; don't give a damn, frankly, my dear.
(concat gnus-newsrc-options
(buffer-substring
- (gnus-point-at-bol)
+ (point-at-bol)
;; Options may continue on the next line.
(or (and (re-search-forward "^[^ \t]" nil 'move)
(progn (beginning-of-line) (point)))
;; The line was buggy.
(setq group nil)
(gnus-error 3.1 "Mangled line: %s"
- (buffer-substring (gnus-point-at-bol)
- (gnus-point-at-eol))))
+ (buffer-substring (point-at-bol)
+ (point-at-eol))))
nil))
;; Skip past ", ". Spaces are invalid in these ranges, but
;; we allow them, because it's a common mistake to put a
(while (re-search-forward "[ \t]-n" nil t)
(setq eol
(or (save-excursion
- (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
+ (and (re-search-forward "[ \t]-n" (point-at-eol) t)
(- (point) 2)))
- (gnus-point-at-eol)))
+ (point-at-eol)))
;; Search for all "words"...
(while (re-search-forward "[^ \t,\n]+" eol t)
(if (eq (char-after (match-beginning 0)) ?!)
(defun gnus-slave-mode ()
"Minor mode for slave Gnusae."
- (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
+ (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
(gnus-run-hooks 'gnus-slave-mode-hook))
(defun gnus-slave-save-newsrc ()
(eval-when-compile
(require 'cl)
- (require 'gnus-clfns)
(defvar tool-bar-map))
(require 'gnus)
"C" gnus-article-capitalize-sentences
"c" gnus-article-remove-cr
"Z" gnus-article-decode-HZ
+ "A" gnus-article-treat-ansi-sequences
"h" gnus-article-wash-html
"u" gnus-article-unsplit-urls
"f" gnus-article-display-x-face
["Unsplit URLs" gnus-article-unsplit-urls t]
["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
["Decode HZ" gnus-article-decode-HZ t]
+ ["ANSI sequences" gnus-article-treat-ansi-sequences t]
("(Outlook) Deuglify"
["Unwrap lines" gnus-article-outlook-unwrap-lines t]
["Repair attribution" gnus-article-outlook-repair-attribution t]
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
- (let ((eol (gnus-point-at-eol))
+ (let ((eol (point-at-eol))
(buffer (current-buffer))
header references in-reply-to)
(setq thread (list (car (gnus-id-to-thread id))))
;; Get the thread this article is part of.
(setq thread (gnus-remove-thread id)))
- (setq old-pos (gnus-point-at-bol))
+ (setq old-pos (point-at-bol))
(setq current (save-excursion
(and (re-search-backward "[\r\n]" nil t)
(gnus-summary-article-number))))
(gnus-summary-show-thread)
(gnus-data-remove
number
- (- (gnus-point-at-bol)
+ (- (point-at-bol)
(prog1
- (1+ (gnus-point-at-eol))
+ (1+ (point-at-eol))
(gnus-delete-line)))))))
(defun gnus-sort-threads-1 (threads func)
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
- (setq xref (buffer-substring (point) (gnus-point-at-eol)))
+ (setq xref (buffer-substring (point) (point-at-eol)))
(mail-header-set-xref headers xref)))))))
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
(goto-char (gnus-data-pos d))
(gnus-data-remove
number
- (- (gnus-point-at-bol)
+ (- (point-at-bol)
(prog1
- (1+ (gnus-point-at-eol))
+ (1+ (point-at-eol))
(gnus-delete-line))))))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(if (null arg) (not gnus-dead-summary-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-dead-summary-mode
- (gnus-add-minor-mode
+ (add-minor-mode
'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
(defun gnus-deaden-summary ()
(defun gnus-summary-update-mark (mark type)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
- (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
+ (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit)
(when forward
(when (looking-at "\r")
(incf forward))
(interactive)
(let ((buffer-read-only nil)
(orig (point))
- (end (gnus-point-at-eol))
+ (end (point-at-eol))
;; Leave point at bol
(beg (progn (beginning-of-line) (point))))
(prog1
(lambda (f)
(if (equal f " ")
f
- (gnus-quote-arg-for-sh-or-csh f)))
+ (shell-quote-argument f)))
files " ")))))
(setq ps (cdr ps)))))
(if (and gnus-view-pseudos (not not-view))
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(when gnus-summary-selected-face
(save-excursion
- (let* ((beg (gnus-point-at-bol))
- (end (gnus-point-at-eol))
+ (let* ((beg (point-at-bol))
+ (end (point-at-eol))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
(defun gnus-summary-highlight-line ()
"Highlight current line according to `gnus-summary-highlight'."
- (let* ((beg (gnus-point-at-bol))
+ (let* ((beg (point-at-bol))
(article (or (gnus-summary-article-number) gnus-current-article))
(score (or (cdr (assq article
gnus-newsgroup-scored))
(let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (get-text-property beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
- beg (gnus-point-at-eol) 'face
+ beg (point-at-eol) 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(funcall gnus-summary-highlight-line-function article face))))))
(insert "Mime-Version: 1.0\n")
(widen)
(when (search-forward "\n--" nil t)
- (let ((separator (buffer-substring (point) (gnus-point-at-eol))))
+ (let ((separator (buffer-substring (point) (point-at-eol))))
(message-narrow-to-head)
(message-remove-header "Content-Type")
(goto-char (point-max))
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'gnus)
(require 'gnus-group)
(defun gnus-group-topic-name ()
"The name of the topic on the current line."
- (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
+ (let ((topic (get-text-property (point-at-bol) 'gnus-topic)))
(and topic (symbol-name topic))))
(defun gnus-group-topic-level ()
"The level of the topic on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
+ (get-text-property (point-at-bol) 'gnus-topic-level))
(defun gnus-group-topic-unread ()
"The number of unread articles in topic on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-topic-unread))
+ (get-text-property (point-at-bol) 'gnus-topic-unread))
(defun gnus-topic-unread (topic)
"Return the number of unread articles in TOPIC."
(defun gnus-topic-visible-p ()
"Return non-nil if the current topic is visible."
- (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
+ (get-text-property (point-at-bol) 'gnus-topic-visible))
(defun gnus-topic-articles-in-topic (entries)
(let ((total 0)
(when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
(gnus-set-format 'topic t)
- (gnus-add-minor-mode 'gnus-topic-mode " Topic"
+ (add-minor-mode 'gnus-topic-mode " Topic"
gnus-topic-mode-map nil (lambda (&rest junk)
(interactive)
(gnus-topic-mode nil t)))
;; Set up the menu.
(when (gnus-visual-p 'undo-menu 'menu)
(gnus-undo-make-menu-bar))
- (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map)
+ (add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map)
(gnus-make-local-hook 'post-command-hook)
(add-hook 'post-command-hook 'gnus-undo-boundary nil t)
(gnus-run-hooks 'gnus-undo-mode-hook)))
(funcall (if (stringp buffer) 'get-buffer 'buffer-name)
buffer))))
-(static-cond
- ((fboundp 'point-at-bol)
- (defalias 'gnus-point-at-bol 'point-at-bol))
- ((fboundp 'line-beginning-position)
- (defalias 'gnus-point-at-bol 'line-beginning-position))
- (t
- (defun gnus-point-at-bol ()
- "Return point at the beginning of the line."
- (let ((p (point)))
- (beginning-of-line)
- (prog1
- (point)
- (goto-char p))))
- ))
-(static-cond
- ((fboundp 'point-at-eol)
- (defalias 'gnus-point-at-eol 'point-at-eol))
- ((fboundp 'line-end-position)
- (defalias 'gnus-point-at-eol 'line-end-position))
- (t
- (defun gnus-point-at-eol ()
- "Return point at the end of the line."
- (let ((p (point)))
- (end-of-line)
- (prog1
- (point)
- (goto-char p))))
- ))
-
;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and
;; XEmacs. In Emacs we don't need to call `make-local-hook' first.
;; It's harmless, though, so the main purpose of this alias is to shut
;; Delete the current line (and the next N lines).
(defmacro gnus-delete-line (&optional n)
- `(delete-region (gnus-point-at-bol)
+ `(delete-region (point-at-bol)
(progn (forward-line ,(or n 1)) (point))))
(defun gnus-byte-code (func)
(defun gnus-goto-colon ()
(beginning-of-line)
- (let ((eol (gnus-point-at-eol)))
+ (let ((eol (point-at-eol)))
(goto-char (or (text-property-any (point) eol 'gnus-position t)
(search-forward ":" eol t)
(point)))))
`(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
(error "Invalid predicate specifier: %s" spec)))))
-(defun gnus-local-map-property (map)
- "Return a list suitable for a text property list specifying keymap MAP."
- (cond
- ((featurep 'xemacs)
- (list 'keymap map))
- ((>= emacs-major-version 21)
- (list 'keymap map))
- (t
- (list 'local-map map))))
-
-(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate
- require-match initial-contents
- history default)
- "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen."
- `(completing-read ,prompt ,table ,predicate ,require-match
- ,initial-contents ,history
- ,@(if (and (featurep 'xemacs) (< emacs-minor-version 2))
- ()
- (list default))))
-
(defun gnus-completing-read (prompt table &optional predicate require-match
history)
(when (and history
(not (boundp history)))
(set history nil))
- (gnus-completing-read-maybe-default
+ (completing-read
(if (symbol-value history)
(concat prompt " (" (car (symbol-value history)) "): ")
(concat prompt ": "))
((eq gnus-user-agent 'gnus)
nil)
((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
- (concat "Emacs/%s" (match-string 1 emacs-version)
+ (concat "Emacs/" (match-string 1 emacs-version)
(if system-v
(concat " (" system-v ")")
"")))
"Various"))))
(goto-char (point-min))
(when (re-search-forward "^Subject: ")
- (delete-region (point) (gnus-point-at-eol))
+ (delete-region (point) (point-at-eol))
(insert subject))
(goto-char (point-min))
(when (re-search-forward "^From:")
- (delete-region (point) (gnus-point-at-eol))
+ (delete-region (point) (point-at-eol))
(insert " " from))
(let ((message-forward-decoded-p t))
(message-forward post))))
(save-restriction
(set-buffer buffer)
(let (buffer-read-only)
- (gnus-set-text-properties (point-min) (point-max) nil)
+ (set-text-properties (point-min) (point-max) nil)
;; These two are necessary for XEmacs 19.12 fascism.
(put-text-property (point-min) (point-max) 'invisible nil)
(put-text-property (point-min) (point-max) 'intangible nil))
;; that the filename will be treated as a single argument when the shell
;; executes the command.
(defun gnus-uu-command (action file)
- (let ((quoted-file (gnus-quote-arg-for-sh-or-csh file)))
+ (let ((quoted-file (shell-quote-argument file)))
(if (string-match "%s" action)
(format action quoted-file)
(concat action " " quoted-file))))
(when (not gnus-uu-post-separate-description)
(set-buffer-modified-p nil)
- (when (fboundp 'bury-buffer)
- (bury-buffer)))))
+ (bury-buffer))))
(provide 'gnus-uu)
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'poe)
(require 'product)
(defvar menu-bar-mode (featurep 'menubar))
(require 'messagexmas)
(require 'wid-edit)
+(require 'run-at-time)
(defgroup gnus-xmas nil
"XEmacsoid support for Gnus"
(defvar standard-display-table)
(defvar gnus-tree-minimize-window)
-(defun gnus-xmas-set-text-properties (start end props &optional buffer)
- "You should NEVER use this function. It is ideologically blasphemous.
-It is provided only to ease porting of broken FSF Emacs programs."
- (if (stringp buffer)
- nil
- (map-extents (lambda (extent ignored)
- (remove-text-properties
- start end
- (list (extent-property extent 'text-prop) nil)
- buffer)
- nil)
- buffer start end nil nil 'text-prop)
- (gnus-add-text-properties start end props buffer)))
-
(defun gnus-xmas-highlight-selected-summary ()
;; Highlight selected article in summary buffer
(when gnus-summary-selected-face
(when gnus-newsgroup-selected-overlay
(delete-extent gnus-newsgroup-selected-overlay))
(setq gnus-newsgroup-selected-overlay
- (make-extent (gnus-point-at-bol) (gnus-point-at-eol)))
+ (make-extent (point-at-bol) (point-at-eol)))
(set-extent-face gnus-newsgroup-selected-overlay
gnus-summary-selected-face)))
(defalias 'gnus-window-edges 'window-pixel-edges)
(defalias 'gnus-assq-delete-all 'gnus-xmas-assq-delete-all)
- (if (and (<= emacs-major-version 19)
- (< emacs-minor-version 14))
- (defalias 'gnus-set-text-properties 'gnus-xmas-set-text-properties))
-
(unless (boundp 'standard-display-table)
(setq standard-display-table nil))
'x-color-values
(lambda (color)
(color-instance-rgb-components
- (make-color-instance color))))))
+ (make-color-instance color)))))
+
+ (unless (fboundp 'char-width)
+ (defalias 'char-width (lambda (ch) 1))))
(defun gnus-xmas-redefine ()
"Redefine lots of Gnus functions for XEmacs."
(defalias 'gnus-create-image 'gnus-xmas-create-image)
(defalias 'gnus-remove-image 'gnus-xmas-remove-image)
- (when (or (< emacs-major-version 21)
- (and (= emacs-major-version 21)
- (< emacs-minor-version 3)))
- (defalias 'gnus-completing-read 'gnus-xmas-completing-read))
-
;; These ones are not defcutom'ed, sometimes not even defvar'ed. They
;; probably should. If that is done, the code below should then be moved
;; where each variable is defined, in order not to mess with user settings.
(defun gnus-group-add-icon ()
"Add an icon to the current line according to `gnus-group-icon-list'."
(let* ((p (point))
- (end (gnus-point-at-eol))
+ (end (point-at-eol))
;; now find out where the line starts and leave point there.
(beg (progn (beginning-of-line) (point))))
(save-restriction
nil)
nil nil nil nil nil 'gnus-image category))
-(defun gnus-xmas-completing-read (prompt table &optional
- predicate require-match history)
- (when (and history
- (not (boundp history)))
- (set history nil))
- (completing-read
- (if (symbol-value history)
- (concat prompt " (" (car (symbol-value history)) "): ")
- (concat prompt ": "))
- table
- predicate
- require-match
- nil
- history))
-
-;; This macro is because XEmacs versions prior to 21.2 do not have the
-;; PROTOCOL argument to `open-network-stream'.
-(defmacro gnus-xmas-open-network-stream (name buffer host service &optional protocol)
- "Like `open-network-stream' but take into account older XEmacs versions."
- (if (and (featurep 'xemacs)
- (fboundp 'open-network-stream)
- (emacs-version>= 21 2))
- `(open-network-stream ,name ,buffer ,host ,service ,protocol)
- `(open-network-stream ,name ,buffer ,host ,service)))
-
(defun gnus-xmas-assq-delete-all (key alist)
(let ((elem nil))
(while (setq elem (assq key alist))
(unless (fboundp 'gnus-group-remove-excess-properties)
(defalias 'gnus-group-remove-excess-properties 'ignore))
-(unless (fboundp 'gnus-set-text-properties)
- (defalias 'gnus-set-text-properties 'set-text-properties))
-
(unless (featurep 'gnus-xmas)
(defalias 'gnus-make-overlay 'make-overlay)
(defalias 'gnus-delete-overlay 'delete-overlay)
;; To make shimbun groups.
(autoload 'gnus-group-make-shimbun-group "nnshimbun" nil t)
-;; A tool for the developers.
-(autoload 'find-cl-run-time-functions "gnus-clfns" nil t)
-
;;; gnus-sum.el thingies
-
(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
"*The format specification of the lines in the summary buffer.
(push c out)))
(range
(while (<= b c)
- (push (mm-make-char 'ascii b) out)
+ (push (make-char 'ascii b) out)
(incf b))
(setq range nil))
((= i (length token))
- (push (mm-make-char 'ascii c) out))
+ (push (make-char 'ascii c) out))
(t
(when b
- (push (mm-make-char 'ascii b) out))
+ (push (make-char 'ascii b) out))
(setq b c))))
(nreverse out)))
(eval-and-compile
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
+ (autoload 'digest-md5-parse-digest-challenge "digest-md5")
+ (autoload 'digest-md5-digest-response "digest-md5")
+ (autoload 'digest-md5-digest-uri "digest-md5")
+ (autoload 'digest-md5-challenge "digest-md5")
(autoload 'rfc2104-hash "rfc2104")
(autoload 'md5 "md5")
(autoload 'utf7-encode "utf7")
(autoload 'utf7-decode "utf7")
(autoload 'format-spec "format-spec")
(autoload 'format-spec-make "format-spec")
- (autoload 'open-tls-stream "tls")
- ;; Avoid use gnus-point-at-eol so we're independent of Gnus. These
- ;; days we have point-at-eol anyhow.
- (if (fboundp 'point-at-eol)
- (defalias 'imap-point-at-eol 'point-at-eol)
- (defun imap-point-at-eol ()
- (save-excursion
- (end-of-line)
- (point))))
- (autoload 'sasl-digest-md5-digest-response "sasl"))
+ (autoload 'open-tls-stream "tls"))
;; User variables.
(list
"AUTHENTICATE DIGEST-MD5"
(lambda (challenge)
- (base64-encode-string
- (sasl-digest-md5-digest-response
- (base64-decode-string challenge)
- user passwd "imap" imap-server)
- 'no-line-break))))))
+ (digest-md5-parse-digest-challenge
+ (base64-decode-string challenge))
+ (let* ((digest-uri
+ (digest-md5-digest-uri
+ "imap" (digest-md5-challenge 'realm)))
+ (response
+ (digest-md5-digest-response
+ user passwd digest-uri)))
+ (base64-encode-string response 'no-line-break))))
+ )))
(if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
nil
(setq imap-continuation nil)
;; next line for Courier IMAP bug.
(skip-chars-forward " ")
(point)))
- (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
+ (> (skip-chars-forward "^ )" (point-at-eol)) 0))
(push (buffer-substring start (point)) flag-list))
(assert (eq (char-after) ?\)) t "In imap-parse-flag-list")
(imap-forward)
(eval-when-compile
(require 'cl)
(require 'imap)
- (defvar display-time-mail-function)
- (autoload 'pop3-movemail "pop3")
- (autoload 'pop3-get-message-count "pop3"))
+ (defvar display-time-mail-function))
(eval-and-compile
- (autoload 'nnheader-cancel-timer "nnheader")
- (autoload 'nnheader-run-at-time "nnheader"))
+ (autoload 'pop3-movemail "pop3")
+ (autoload 'pop3-get-message-count "pop3")
+ (autoload 'nnheader-cancel-timer "nnheader"))
(require 'format-spec)
(require 'message) ;; for `message-directory'
(setq display-time-mail-function #'mail-source-new-mail-p)
;; Set up the main timer.
(setq mail-source-report-new-mail-timer
- (nnheader-run-at-time
+ (run-at-time
(* 60 mail-source-report-new-mail-interval)
(* 60 mail-source-report-new-mail-interval)
#'mail-source-start-idle-timer))
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-new-draft-name "mh-comp")
(autoload 'mh-send-letter "mh-comp")
- (autoload 'gnus-point-at-eol "gnus-util")
- (autoload 'gnus-point-at-bol "gnus-util")
(autoload 'gnus-output-to-rmail "gnus-util")
(autoload 'gnus-output-to-mail "gnus-util")
(autoload 'nndraft-request-associate-buffer "nndraft")
font-lock-face highlight))))
(when hidden-start
(goto-char hidden-start)
- (set-window-start (selected-window) (gnus-point-at-bol))
+ (set-window-start (selected-window) (point-at-bol))
(unless (yes-or-no-p
"Invisible text found and made visible; continue sending? ")
(error "Invisible text found and made visible")))))
(forward-line -1)))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
- (delete-region (point) (gnus-point-at-eol))
+ (delete-region (point) (point-at-eol))
;; If the header is optional, and the header was
;; empty, we can't insert it anyway.
(unless optionalp
(message-point-in-header-p))
(let* ((here (point))
(bol (progn (beginning-of-line n) (point)))
- (eol (gnus-point-at-eol))
+ (eol (point-at-eol))
(eoh (re-search-forward ": *" eol t)))
(if (or (not eoh) (equal here eoh))
(goto-char bol)
'message-xmas-exchange-point-and-mark)
(defalias 'message-mark-active-p
'region-exists-p)
- (when (>= emacs-major-version 20)
- (defalias 'message-make-caesar-translation-table
- 'message-xmas-make-caesar-translation-table))
+ (defalias 'message-make-caesar-translation-table
+ 'message-xmas-make-caesar-translation-table)
(defalias 'message-make-overlay 'make-extent)
(defalias 'message-delete-overlay 'delete-extent)
(defalias 'message-overlay-put 'set-extent-property))
(string= total "'%s'")
(string= total "\"%s\""))
(setq uses-stdin nil)
- (push (mm-quote-arg
+ (push (shell-quote-argument
(gnus-map-function mm-path-name-rewrite-functions file)) out))
((string= total "%t")
- (push (mm-quote-arg (car type-list)) out))
+ (push (shell-quote-argument (car type-list)) out))
(t
- (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
+ (push (shell-quote-argument (or (cdr (assq (intern sub) ctl)) "")) out))))
(push (substring method beg (length method)) out)
(when uses-stdin
(push "<" out)
- (push (mm-quote-arg
+ (push (shell-quote-argument
(gnus-map-function mm-path-name-rewrite-functions file))
out))
(mapconcat 'identity (nreverse out) "")))
;;; Code:
-(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
-(eval-when-compile (require 'static))
+(eval-when-compile
+ (require 'cl)
+ (require 'static))
(require 'mail-prsvr)
(coding-system-equal . equal)
(annotationp . ignore)
(set-buffer-file-coding-system . ignore)
- (make-char
- . (lambda (charset int)
- (int-to-char int)))
(read-charset
. (lambda (prompt)
"Return a charset."
mm-mime-mule-charset-alist)))))
(list 'ascii (or charset 'latin-iso8859-1)))))))))
-(static-if (fboundp 'shell-quote-argument)
- (defalias 'mm-quote-arg 'shell-quote-argument)
- (defun mm-quote-arg (arg)
- "Return a version of ARG that is safe to evaluate in a shell."
- (let ((pos 0) new-pos accum)
- ;; *** bug: we don't handle newline characters properly
- (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos))
- (push (substring arg pos new-pos) accum)
- (push "\\" accum)
- (push (list (aref arg new-pos)) accum)
- (setq pos (1+ new-pos)))
- (if (= pos 0)
- arg
- (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))))
-
(defun mm-auto-mode-alist ()
"Return an `auto-mode-alist' with only the .gz (etc) thingies."
(let ((alist auto-mode-alist)
(sit-for 1)
t)
-(autoload 'gnus-completing-read-maybe-default "gnus-util" nil nil 'macro)
-
(defun mm-view-pkcs7-decrypt (handle)
(insert-buffer-substring (mm-handle-buffer handle))
(goto-char (point-min))
(if (= (length smime-keys) 1)
(cadar smime-keys)
(smime-get-key-by-email
- (gnus-completing-read-maybe-default
+ (completing-read
(concat "Decipher using which key? "
(if smime-keys (concat "(default " (caar smime-keys) ") ")
""))
(eval-and-compile
(autoload 'message-make-message-id "message")
(autoload 'gnus-setup-posting-charset "gnus-msg")
- (autoload 'gnus-add-minor-mode "gnus-ems")
(autoload 'gnus-make-local-hook "gnus-util")
(autoload 'message-fetch-field "message")
(autoload 'fill-flowed-encode "flow-fill")
(when (set (make-local-variable 'mml-mode)
(if (null arg) (not mml-mode)
(> (prefix-numeric-value arg) 0)))
- (gnus-add-minor-mode 'mml-mode " MML" mml-mode-map)
+ (add-minor-mode 'mml-mode " MML" mml-mode-map)
(easy-menu-add mml-menu mml-mode-map)
(run-hooks 'mml-mode-hook)))
(if (string-match "^text/.*" type)
"inline"
"attachment")))
- (disposition (completing-read "Disposition: "
- '(("attachment") ("inline") (""))
- nil
- nil)))
+ (disposition (completing-read
+ (format "Disposition: (default %s): " default)
+ '(("attachment") ("inline") (""))
+ nil
+ nil)))
(if (not (equal disposition ""))
disposition
default)))
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'mm-decode)
(require 'mm-util)
(require 'mml)
;;; Code:
;;;
-;;; .netrc and .authinforc parsing
+;;; .netrc and .authinfo rc parsing
;;;
+;; autoload password
(eval-and-compile
- (defalias 'netrc-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
+ (autoload 'password-read "password"))
+
+(defgroup netrc nil
+ "Netrc configuration.")
+
+(defcustom netrc-encrypting-method nil
+ "Decoding method used for the netrc file.
+Use the OpenSSL symmetric ciphers here. Leave nil for no
+decoding. Encrypt the file with netrc-encrypt, but make sure you
+have set netrc-encrypting-method to a non-nil value."
+ :type '(choice
+ (const :tag "DES-3" "des3")
+ (const :tag "IDEA" "idea")
+ (const :tag "RC4" "rc4")
+ (string :tag "Explicit cipher name")
+ (const :tag "None" nil))
+ :group 'netrc)
+
+(defcustom netrc-openssl-path (executable-find "openssl")
+ "File path of the OpenSSL shell."
+ :type '(choice (file :tag "Location of openssl")
+ (const :tag "openssl is not installed" nil))
+ :group 'netrc)
+
+(defun netrc-encrypt (plain-file encrypted-file)
+ (interactive "fPlain File: \nFEncrypted File: ")
+ "Encrypt FILE to ENCRYPTED-FILE with netrc-encrypting-method cipher."
+ (when (and (file-exists-p plain-file)
+ (stringp encrypted-file)
+ netrc-encrypting-method
+ netrc-openssl-path)
+ (let ((buffer-file-coding-system 'binary)
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (password
+ (password-read
+ (format "OpenSSL Password for cipher %s? "
+ netrc-encrypting-method)
+ (format "netrc-openssl-password-%s"
+ netrc-encrypting-method))))
+ (when password
+ (with-temp-buffer
+ (insert-file-contents plain-file)
+ (setenv "NETRC_OPENSSL_PASSWORD" password)
+ (shell-command-on-region
+ (point-min)
+ (point-max)
+ (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -e"
+ netrc-openssl-path
+ netrc-encrypting-method)
+ t
+ t)
+ (write-file encrypted-file t))))))
(defun netrc-parse (file)
+ (interactive "fFile to Parse: ")
"Parse FILE and return an list of all entries in the file."
(when (file-exists-p file)
(with-temp-buffer
"password" "account" "macdef" "force"
"port"))
alist elem result pair)
- (insert-file-contents file)
+ (if (and netrc-encrypting-method
+ netrc-openssl-path)
+ (let ((buffer-file-coding-system 'binary)
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (password
+ (password-read
+ (format "OpenSSL Password for cipher %s? "
+ netrc-encrypting-method)
+ (format "netrc-openssl-password-%s"
+ netrc-encrypting-method))))
+ (when password
+ (insert-file-contents file)
+ (setenv "NETRC_OPENSSL_PASSWORD" password)
+ (shell-command-on-region
+ (point-min)
+ (point-max)
+ (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -d"
+ netrc-openssl-path
+ netrc-encrypting-method)
+ t
+ t)))
+ (insert-file-contents file))
(goto-char (point-min))
;; Go through the file, line by line.
(while (not (eobp))
- (narrow-to-region (point) (netrc-point-at-eol))
+ (narrow-to-region (point) (point-at-eol))
;; For each line, get the tokens and values.
(while (not (eobp))
(skip-chars-forward "\t ")
(defvoo nnbabyl-previous-buffer-mode nil)
-(eval-and-compile
- (autoload 'gnus-set-text-properties "gnus-ems"))
-
\f
;;; Interface functions
(save-excursion
(set-buffer nnbabyl-mbox-buffer)
- (gnus-set-text-properties (point-min) (point-max) nil)
+ (set-text-properties (point-min) (point-max) nil)
(while (and articles is-old)
(goto-char (point-min))
(when (search-forward (nnbabyl-article-string (car articles)) nil t)
(search-forward id nil t)) ; We find the ID.
;; And the id is in the fourth field.
(if (not (and (search-backward "\t" nil t 4)
- (not (search-backward"\t" (gnus-point-at-bol) t))))
+ (not (search-backward"\t" (point-at-bol) t))))
(forward-line 1)
(beginning-of-line)
(setq found t)
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nnheader)
(require 'message)
(goto-char (match-end 0))
(setq num (string-to-int
(buffer-substring
- (point) (gnus-point-at-eol))))
+ (point) (point-at-eol))))
(goto-char start)
(< num article)))
;; Check that we are before an article with a
(progn
(setq num (string-to-int
(buffer-substring
- (point) (gnus-point-at-eol))))
+ (point) (point-at-eol))))
(> num article))
;; Discard any article numbers before the one we're
;; now looking at.
(if (search-forward (concat "\n" nnfolder-article-marker)
nil t)
(string-to-int (buffer-substring
- (point) (gnus-point-at-eol)))
+ (point) (point-at-eol)))
-1))))))))
(deffoo nnfolder-request-group (group &optional server dont-check)
(autoload 'nnmail-message-id "nnmail")
(autoload 'mail-position-on-field "sendmail")
(autoload 'message-remove-header "message")
- (autoload 'gnus-point-at-eol "gnus-util")
(autoload 'gnus-buffer-live-p "gnus-util"))
;; mm-util stuff.
(first t)
(bol (save-restriction
(widen)
- (gnus-point-at-bol))))
+ (point-at-bol))))
(while (not (eobp))
(when (and (or break qword-break)
(> (- (point) bol) 76))
(goto-char (point-min))
(let ((bol (save-restriction
(widen)
- (gnus-point-at-bol)))
- (eol (gnus-point-at-eol)))
+ (point-at-bol)))
+ (eol (point-at-eol)))
(forward-line 1)
(while (not (eobp))
(if (and (looking-at "[ \t]")
- (< (- (gnus-point-at-eol) bol) 76))
+ (< (- (point-at-eol) bol) 76))
(delete-region eol (progn
(goto-char eol)
(skip-chars-forward "\r\n")
(point)))
- (setq bol (gnus-point-at-bol)))
- (setq eol (gnus-point-at-eol))
+ (setq bol (point-at-bol)))
+ (setq eol (point-at-eol))
(forward-line 1)))))))
(unless (fboundp 'std11-unfold-field)
(goto-char p)
(if (search-forward "\nmessage-id:" nil t)
(buffer-substring
- (1- (or (search-forward "<" (gnus-point-at-eol) t)
+ (1- (or (search-forward "<" (point-at-eol) t)
(point)))
- (or (search-forward ">" (gnus-point-at-eol) t) (point)))
+ (or (search-forward ">" (point-at-eol) t) (point)))
;; If there was no message-id, we just fake one to make
;; subsequent routines simpler.
(nnheader-generate-fake-message-id)))
(nnheader-generate-fake-message-id))))
(defun nnheader-parse-nov ()
- (let ((eol (gnus-point-at-eol)))
+ (let ((eol (point-at-eol)))
(make-full-mail-header
(nnheader-nov-read-integer) ; number
(nnheader-nov-field) ; subject
;; This is invalid, but not all articles have Message-IDs.
()
(mail-position-on-field "References")
- (let ((begin (gnus-point-at-bol))
+ (let ((begin (point-at-bol))
(fill-column 78)
(fill-prefix "\t"))
(when references
"Strip all \r's from the current buffer."
(nnheader-skeleton-replace "\r"))
-(defalias 'nnheader-run-at-time 'run-at-time)
(defalias 'nnheader-cancel-timer 'cancel-timer)
(defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
(defalias 'nnheader-string-as-multibyte 'string-as-multibyte)
;;; Code:
-(if (condition-case nil
- (progn
- (unless (or itimer-process itimer-timer)
- (itimer-driver-start))
- ;; Check whether there is a bug to which the difference of
- ;; the present time and the time when the itimer driver was
- ;; woken up is subtracted from the initial itimer value.
- (let* ((inhibit-quit t)
- (ctime (current-time))
- (itimer-timer-last-wakeup
- (prog1
- ctime
- (setcar ctime (1- (car ctime)))))
- (itimer-list nil)
- (itimer (start-itimer "nnheader-run-at-time" 'ignore 5)))
- (sleep-for 0.1) ;; Accept the timeout interrupt.
- (prog1
- (> (itimer-value itimer) 0)
- (delete-itimer itimer))))
- (error nil))
- (defun nnheader-xmas-run-at-time (time repeat function &rest args)
- "Emulating function run as `run-at-time'.
-TIME should be nil meaning now, or a number of seconds from now.
-Return an itimer object which can be used in either `delete-itimer'
-or `cancel-timer'."
- (apply #'start-itimer "nnheader-run-at-time"
- function (if time (max time 1e-9) 1e-9)
- repeat nil t args))
- (defun nnheader-xmas-run-at-time (time repeat function &rest args)
- "Emulating function run as `run-at-time' in the right way.
-TIME should be nil meaning now, or a number of seconds from now.
-Return an itimer object which can be used in either `delete-itimer'
-or `cancel-timer'."
- (let ((itimers (list nil)))
- (setcar
- itimers
- (apply #'start-itimer "nnheader-run-at-time"
- (lambda (itimers repeat function &rest args)
- (let ((itimer (car itimers)))
- (if repeat
- (progn
- (set-itimer-function
- itimer
- (lambda (itimer repeat function &rest args)
- (set-itimer-restart itimer repeat)
- (set-itimer-function itimer function)
- (set-itimer-function-arguments itimer args)
- (apply function args)))
- (set-itimer-function-arguments
- itimer
- (append (list itimer repeat function) args)))
- (set-itimer-function
- itimer
- (lambda (itimer function &rest args)
- (delete-itimer itimer)
- (apply function args)))
- (set-itimer-function-arguments
- itimer
- (append (list itimer function) args)))))
- 1e-9 (if time (max time 1e-9) 1e-9)
- nil t itimers repeat function args)))))
+(require 'run-at-time)
+
+(defalias 'nnheader-cancel-timer 'delete-itimer)
+(defalias 'nnheader-cancel-function-timers 'ignore)
+(defalias 'nnheader-string-as-multibyte 'identity)
(defun nnheader-xmas-Y-or-n-p (prompt)
"Ask user a \"Y/n\" question. Return t if answer is neither \"n\", \"N\" nor \"C-g\"."
(message "%s(Y/n) Yes" prompt)
t))))
-(defalias 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
-(defalias 'nnheader-cancel-timer 'delete-itimer)
-(defalias 'nnheader-cancel-function-timers 'ignore)
-(defalias 'nnheader-string-as-multibyte 'identity)
(defalias 'nnheader-Y-or-n-p 'nnheader-xmas-Y-or-n-p)
(provide 'nnheaderxm)
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'imap)
(require 'nnoo)
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nntp)
(require 'nnheader)
(while (not (eobp))
(condition-case err
(progn
- (narrow-to-region (point) (gnus-point-at-eol))
+ (narrow-to-region (point) (point-at-eol))
(setq group (read buffer))
(unless (stringp group)
(setq group (symbol-name group)))
(while (not (eobp))
(unless (< (move-to-column nnmail-split-header-length-limit)
nnmail-split-header-length-limit)
- (delete-region (point) (gnus-point-at-eol)))
+ (delete-region (point) (point-at-eol)))
(forward-line 1))
;; Allow washing.
(goto-char (point-min))
(skip-chars-forward "^\n\r\t")
(unless (looking-at "[\r\n]")
(forward-char 1)
- (buffer-substring (point) (gnus-point-at-eol)))))))
+ (buffer-substring (point) (point-at-eol)))))))
;; Function for nnmail-split-fancy: look up all references in the
;; cache and if a match is found, return that group.
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nnheader)
(require 'nnmail)
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'gnus)
(require 'nnheader)
(search-forward id nil t)) ; We find the ID.
;; And the id is in the fourth field.
(if (not (and (search-backward "\t" nil t 4)
- (not (search-backward"\t" (gnus-point-at-bol) t))))
+ (not (search-backward "\t" (point-at-bol) t))))
(forward-line 1)
(beginning-of-line)
(setq found t)
(nnheader-insert-nov headers)))
(defsubst nnml-header-value ()
- (buffer-substring (match-end 0) (gnus-point-at-eol)))
+ (buffer-substring (match-end 0) (point-at-eol)))
(defun nnml-parse-head (chars &optional number)
"Parse the head of the current buffer."
+++ /dev/null
-;;; nnshimbun.el --- interfacing with web newspapers
-
-;; Copyright (C) 2000,2001,2002 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
-;; Authors: TSUCHIYA Masatoshi <tsuchiya@namazu.org>,
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>,
-;; Katsumi Yamaoka <yamaoka@jpl.org>,
-;; Yuuichi Teranishi <teranisi@gohome.org>
-;; Keywords: news
-
-;; This file is a part of Semi-Gnus.
-
-;; 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 2, 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, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Gnus (or gnus) backend to read newspapers on the World Wide Web.
-;; This module requires the emacs-w3m and the external command w3m.
-;; Visit the following pages for more information.
-;;
-;; http://emacs-w3m.namazu.org/
-;; http://w3m.sourceforge.net/
-
-;; If you would like to use this module in Gnus (not T-gnus), put this
-;; file into the lisp/ directory in the Gnus source tree and run `make
-;; install'. And then, put the following expression into your ~/.gnus.
-;;
-;; (autoload 'gnus-group-make-shimbun-group "nnshimbun" nil t)
-
-
-;;; Definitions:
-
-(eval-when-compile (require 'cl))
-(require 'nnoo)
-(require 'nnheader)
-(require 'nnmail)
-(require 'gnus-bcklg)
-(require 'shimbun)
-
-
-;; Customize variables
-(defgroup nnshimbun nil
- "Reading Web Newspapers with Gnus."
- :group 'gnus)
-
-(defvar nnshimbun-group-parameters-custom
- '(list :format "%v"
- (checklist :inline t
- (list :inline t :format "%v"
- (const :format "" index-range)
- (choice :tag "Index range"
- :value all
- (const all)
- (const last)
- (integer :tag "days")))
- (list :inline t :format "%v"
- (const :format "" prefetch-articles)
- (choice :tag "Prefetch articles"
- :value off
- (const on)
- (const off)))
- (list :inline t :format "%v"
- (const :format "" encapsulate-images)
- (choice :tag "Encapsulate article"
- :value on
- (const on)
- (const off)))
- (list :inline t :format "%v"
- (const :format "" expiry-wait)
- (choice :tag "Expire wait"
- :value never
- (const never)
- (const immediate)
- (number :tag "days"))))
- (repeat :inline t :tag "Others"
- (list :inline t :format "%v"
- (symbol :tag "Keyword")
- (sexp :tag "Value"))))
- "A type definition for customizing the nnshimbun group parameters.")
-
-;; The following definition provides the group parameter
-;; `nnshimbun-group-parameters', the user option
-;; `nnshimbun-group-parameters-alist' and the function
-;; `nnshimbun-find-group-parameters'.
-;; The group parameter `nnshimbun-group-parameters' will have a
-;; property list like the following:
-;;
-;; '(index-range all prefetch-articles off encapsulate-images on
-;; expiry-wait 6)
-
-(unless (fboundp 'gnus-define-group-parameter)
- (defmacro gnus-define-group-parameter (&rest args) nil)
- (defun nnshimbun-find-group-parameters (name)
- "Return a nnshimbun GROUP's group parameters."
- (when name
- (or (gnus-group-find-parameter name 'nnshimbun-group-parameters t)
- (assoc-default name
- (and (boundp 'nnshimbun-group-parameters-alist)
- (symbol-value 'nnshimbun-group-parameters-alist))
- (function string-match))))))
-
-(gnus-define-group-parameter
- nnshimbun-group-parameters
- :type list
- :function nnshimbun-find-group-parameters
- :function-document "\
-Return a nnshimbun GROUP's group parameters."
- :variable nnshimbun-group-parameters-alist
- :variable-default nil
- :variable-document "\
-Alist of nnshimbun group parameters. Each element should be a cons of
-a group name regexp and a plist which consists of a keyword and a value
-pairs like the following:
-
-'(\"^nnshimbun\\\\+asahi:\" index-range all prefetch-articles off
- encapsulate-images on expiry-wait 6)
-
-`index-range' specifies a range of header indices as described below:
- all: Retrieve all header indices.
- last: Retrieve the last header index.
-integer N: Retrieve N pages of header indices.
-
-`prefetch-articles' specifies whether to pre-fetch the unread articles
-when scanning the group.
-
-`encapsulate-images' specifies whether inline images in the shimbun
-article are encapsulated.
-
-`expiry-wait' is similar to the generic group parameter `expiry-wait',
-but it has a preference."
- :variable-group nnshimbun
- :variable-type `(repeat (cons :format "%v" (regexp :tag "Group name regexp"
- :value "^nnshimbun\\+")
- ,nnshimbun-group-parameters-custom))
- :parameter-type nnshimbun-group-parameters-custom
- :parameter-document "\
-Group parameters for the nnshimbun group.
-
-`Index range' specifies a range of header indices as described below:
- all: Retrieve all header indices.
- last: Retrieve the last header index.
-integer N: Retrieve N pages of header indices.
-
-`Prefetch articles' specifies whether to pre-fetch the unread articles
-when scanning the group.
-
-`Encapsulate article' specifies whether inline images in the shimbun
-article are encapsulated.
-
-`Expire wait' is similar to the generic group parameter `expiry-wait',
-but it has a preference.")
-
-(defcustom nnshimbun-keep-unparsable-dated-articles t "\
-*If non-nil, nnshimbun will never delete articles whose NOV date is unparsable."
- :group 'nnshimbun
- :type 'boolean)
-
-
-;; Define backend
-(gnus-declare-backend "nnshimbun" 'address)
-(nnoo-declare nnshimbun)
-
-(defvoo nnshimbun-directory (nnheader-concat gnus-directory "shimbun/")
- "Where nnshimbun will save its files.")
-
-(defvoo nnshimbun-nov-is-evil nil
- "*Non-nil means that nnshimbun will never retrieve NOV headers.")
-
-(defvoo nnshimbun-nov-file-name ".overview")
-
-(defvoo nnshimbun-pre-fetch-article 'off
- "*If it is neither `off' nor nil, nnshimbun fetch unread articles when
-scanning groups. Note that this variable has just a default value for
-all the nnshimbun groups. You can specify the nnshimbun group
-parameter `prefecth-articles' for each nnshimbun group.")
-
-(defvoo nnshimbun-encapsulate-images shimbun-encapsulate-images
- "*If it is neither `off' nor nil, inline images will be encapsulated in
-the articles. Note that this variable has just a default value for
-all the nnshimbun groups. You can specify the nnshimbun group
-parameter `encapsulate-images' for each nnshimbun group.")
-
-(defvoo nnshimbun-index-range nil
- "*Range of indices to detect new pages. Note that this variable has
-just a default value for all the nnshimbun groups. You can specify
-the nnshimbun group parameter `index-range' for each nnshimbun group.")
-
-
-;; set by nnshimbun-open-server
-(defvoo nnshimbun-shimbun nil)
-
-(defvoo nnshimbun-status-string "")
-(defvoo nnshimbun-keep-backlog 300)
-(defvoo nnshimbun-backlog-articles nil)
-(defvoo nnshimbun-backlog-hashtb nil)
-
-
-;;; backlog
-(defmacro nnshimbun-current-server ()
- '(nnoo-current-server 'nnshimbun))
-
-(defmacro nnshimbun-server-directory (&optional server)
- `(nnmail-group-pathname ,(or server '(nnshimbun-current-server))
- nnshimbun-directory))
-
-(defmacro nnshimbun-current-group ()
- '(shimbun-current-group-internal nnshimbun-shimbun))
-
-(defmacro nnshimbun-current-directory (&optional group)
- `(nnmail-group-pathname ,(or group '(nnshimbun-current-group))
- (nnshimbun-server-directory)))
-
-(defmacro nnshimbun-backlog (&rest form)
- `(let ((gnus-keep-backlog nnshimbun-keep-backlog)
- (gnus-backlog-buffer
- (format " *nnshimbun backlog %s*" (nnshimbun-current-server)))
- (gnus-backlog-articles nnshimbun-backlog-articles)
- (gnus-backlog-hashtb nnshimbun-backlog-hashtb))
- (unwind-protect
- (progn ,@form)
- (setq nnshimbun-backlog-articles gnus-backlog-articles
- nnshimbun-backlog-hashtb gnus-backlog-hashtb))))
-(put 'nnshimbun-backlog 'lisp-indent-function 0)
-(put 'nnshimbun-backlog 'edebug-form-spec t)
-
-
-;;; Group parameter
-(defmacro nnshimbun-find-parameter (group symbol &optional full-name-p)
- "Return the value of a nnshimbun group parameter for GROUP which is
-associated with SYMBOL. If FULL-NAME-P is non-nil, it treats that
-GROUP has a full name."
- (let ((name (if full-name-p
- group
- `(concat "nnshimbun+" (nnshimbun-current-server) ":" ,group))))
- (cond ((eq 'index-range (eval symbol))
- `(or (plist-get (nnshimbun-find-group-parameters ,name)
- 'index-range)
- nnshimbun-index-range))
- ((eq 'prefetch-articles (eval symbol))
- `(let ((val (or (plist-get (nnshimbun-find-group-parameters ,name)
- 'prefetch-articles)
- nnshimbun-pre-fetch-article)))
- (if (eq 'off val)
- nil
- val)))
- ((eq 'encapsulate-images (eval symbol))
- `(let ((val (or (plist-get (nnshimbun-find-group-parameters ,name)
- 'encapsulate-images)
- nnshimbun-encapsulate-images)))
- (if (eq 'off val)
- nil
- val)))
- ((eq 'expiry-wait (eval symbol))
- (if full-name-p
- `(or (plist-get (nnshimbun-find-group-parameters ,group)
- 'expiry-wait)
- (gnus-group-find-parameter ,group 'expiry-wait))
- `(let ((name ,name))
- (or (plist-get (nnshimbun-find-group-parameters name)
- 'expiry-wait)
- (gnus-group-find-parameter name 'expiry-wait)))))
- (t
- `(plist-get (nnshimbun-find-group-parameters ,name) ,symbol)))))
-
-
-;;; Interface Functions
-(nnoo-define-basics nnshimbun)
-
-(defun nnshimbun-possibly-change-group (group &optional server)
- (when (if server
- (nnshimbun-open-server server)
- nnshimbun-shimbun)
- (or (not group)
- (when (condition-case err
- (shimbun-open-group nnshimbun-shimbun group)
- (error
- (nnheader-report 'nnshimbun "%s" (error-message-string err))))
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (dir (nnshimbun-current-directory group)))
- (or (file-directory-p dir)
- (ignore-errors
- (make-directory dir)
- (file-directory-p dir))
- (nnheader-report 'nnshimbun
- (if (file-exists-p dir)
- "Not a directory: %s"
- "Couldn't create directory: %s")
- dir)))))))
-
-(deffoo nnshimbun-open-server (server &optional defs)
- (or (nnshimbun-server-opened server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (shimbun))
- (when (condition-case err
- (setq shimbun
- (shimbun-open server
- (luna-make-entity 'shimbun-gnus-mua)))
- (error
- (nnheader-report 'nnshimbun "%s" (error-message-string err))))
- (nnoo-change-server 'nnshimbun server
- (cons (list 'nnshimbun-shimbun shimbun) defs))
- (when (or (file-directory-p nnshimbun-directory)
- (ignore-errors
- (make-directory nnshimbun-directory)
- (file-directory-p nnshimbun-directory))
- (progn
- (nnshimbun-close-server)
- (nnheader-report 'nnshimbun
- (if (file-exists-p nnshimbun-directory)
- "Not a directory: %s"
- "Couldn't create directory: %s")
- nnshimbun-directory)))
- (let ((dir (nnshimbun-server-directory server)))
- (when (or (file-directory-p dir)
- (ignore-errors
- (make-directory dir)
- (file-directory-p dir))
- (progn
- (nnshimbun-close-server)
- (nnheader-report 'nnshimbun
- (if (file-exists-p dir)
- "Not a directory: %s"
- "Couldn't create directory: %s")
- dir)))
- (nnheader-report 'nnshimbun
- "Opened server %s using directory %s"
- server dir)
- t)))))))
-
-(deffoo nnshimbun-close-server (&optional server)
- (when (nnshimbun-server-opened server)
- (when nnshimbun-shimbun
- (dolist (group (shimbun-groups nnshimbun-shimbun))
- (nnshimbun-write-nov group t))
- (shimbun-close nnshimbun-shimbun)))
- (nnshimbun-backlog (gnus-backlog-shutdown))
- (nnoo-close-server 'nnshimbun server)
- t)
-
-(eval-when-compile
- (require 'gnus-sum)) ;; For the macro `gnus-summary-article-header'.
-
-(defun nnshimbun-request-article-1 (article &optional group server to-buffer)
- (if (nnshimbun-backlog
- (gnus-backlog-request-article
- group article (or to-buffer nntp-server-buffer)))
- (cons group article)
- (let* ((header (with-current-buffer (nnshimbun-open-nov group)
- (and (nnheader-find-nov-line article)
- (nnshimbun-parse-nov))))
- (original-id (shimbun-header-id header)))
- (when header
- (with-current-buffer (or to-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((shimbun-encapsulate-images
- (nnshimbun-find-parameter group 'encapsulate-images)))
- (shimbun-article nnshimbun-shimbun header))
- (when (> (buffer-size) 0)
- ;; Kludge! replace a date string in `gnus-newsgroup-data'
- ;; based on the newly retrieved article.
- (let ((x (gnus-summary-article-header article)))
- (when x
- ;; Trick to suppress byte compile of mail-header-set-date(),
- ;; in order to keep compatibility between T-gnus and Oort Gnus.
- (eval
- `(mail-header-set-date ,x ,(shimbun-header-date header)))))
- (nnshimbun-replace-nov-entry group article header original-id)
- (nnshimbun-backlog
- (gnus-backlog-enter-article group article (current-buffer)))
- (nnheader-report 'nnshimbun "Article %s retrieved"
- (shimbun-header-id header))
- (cons group article)))))))
-
-(deffoo nnshimbun-request-article (article &optional group server to-buffer)
- (when (nnshimbun-possibly-change-group group server)
- (if (or (integerp article)
- (when (stringp article)
- (setq article
- (or (when (or group (setq group (nnshimbun-current-group)))
- (nnshimbun-search-id group article))
- (catch 'found
- (dolist (x (shimbun-groups nnshimbun-shimbun))
- (and (nnshimbun-possibly-change-group x)
- (setq x (nnshimbun-search-id x article))
- (throw 'found x))))))))
- (nnshimbun-request-article-1 article group server to-buffer)
- (nnheader-report 'nnshimbun "Couldn't retrieve article: %s"
- (prin1-to-string article)))))
-
-(deffoo nnshimbun-request-group (group &optional server dont-check)
- (if (not (nnshimbun-possibly-change-group group server))
- (nnheader-report 'nnshimbun "Invalid group (no such directory)")
- (let (beg end lines)
- (with-current-buffer (nnshimbun-open-nov group)
- (goto-char (point-min))
- (setq beg (ignore-errors (read (current-buffer))))
- (goto-char (point-max))
- (forward-line -1)
- (setq end (ignore-errors (read (current-buffer)))
- lines (count-lines (point-min) (point-max))))
- (nnheader-report 'nnshimbun "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
- lines (or beg 0) (or end 0) group))))
-
-(deffoo nnshimbun-request-scan (&optional group server)
- (when (nnshimbun-possibly-change-group nil server)
- (if group
- (nnshimbun-generate-nov-database group)
- (dolist (group (shimbun-groups nnshimbun-shimbun))
- (nnshimbun-generate-nov-database group)))))
-
-(deffoo nnshimbun-close-group (group &optional server)
- (nnshimbun-write-nov group)
- t)
-
-(deffoo nnshimbun-request-list (&optional server)
- (when (nnshimbun-possibly-change-group nil server)
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (dolist (group (shimbun-groups nnshimbun-shimbun))
- (when (nnshimbun-possibly-change-group group)
- (let (beg end)
- (with-current-buffer (nnshimbun-open-nov group)
- (goto-char (point-min))
- (setq beg (ignore-errors (read (current-buffer))))
- (goto-char (point-max))
- (forward-line -1)
- (setq end (ignore-errors (read (current-buffer)))))
- (insert (format "%s %d %d n\n" group (or end 0) (or beg 0)))))))
- t)) ; return value
-
-(deffoo nnshimbun-retrieve-headers (articles &optional group server fetch-old)
- (when (nnshimbun-possibly-change-group group server)
- (if (nnshimbun-retrieve-headers-with-nov articles group fetch-old)
- 'nov
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (let (header)
- (dolist (art articles)
- (when (and (if (stringp art)
- (setq art (nnshimbun-search-id group art))
- (integerp art))
- (setq header
- (with-current-buffer (nnshimbun-open-nov group)
- (and (nnheader-find-nov-line art)
- (nnshimbun-parse-nov)))))
- (insert (format "220 %d Article retrieved.\n" art))
- (shimbun-header-insert nnshimbun-shimbun header)
- (insert ".\n")
- (delete-region (point) (point-max)))))
- 'header))))
-
-(defun nnshimbun-retrieve-headers-with-nov (articles &optional group fetch-old)
- (unless (or gnus-nov-is-evil nnshimbun-nov-is-evil)
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert-buffer (nnshimbun-open-nov group))
- (unless (and fetch-old (not (numberp fetch-old)))
- (nnheader-nov-delete-outside-range
- (if fetch-old
- (max 1 (- (car articles) fetch-old))
- (car articles))
- (nth (1- (length articles)) articles)))
- t)))
-
-
-;;; Nov Database Operations
-(defvar nnshimbun-tmp-string nil
- "Internal variable used to just a rest for a temporary string. The
-macro `nnshimbun-string-or' uses it exclusively.")
-
-(defmacro nnshimbun-string-or (&rest strings)
- "Return the first element of STRINGS that is a non-blank string. It
-should run fast, especially if two strings are given. Each string can
-also be nil."
- (cond ((null strings)
- nil)
- ((= 1 (length strings))
- ;; Return irregularly nil if one blank string is given.
- `(unless (zerop (length (setq nnshimbun-tmp-string ,(car strings))))
- nnshimbun-tmp-string))
- ((= 2 (length strings))
- ;; Return the second string when the first string is blank.
- `(if (zerop (length (setq nnshimbun-tmp-string ,(car strings))))
- ,(cadr strings)
- nnshimbun-tmp-string))
- (t
- `(let ((strings (list ,@strings)))
- (while strings
- (setq strings (if (zerop (length (setq nnshimbun-tmp-string
- (car strings))))
- (cdr strings))))
- nnshimbun-tmp-string))))
-
-(autoload 'message-make-date "message")
-
-(defsubst nnshimbun-insert-nov (number header &optional id)
- (insert "\n")
- (backward-char 1)
- (let ((header-id (nnshimbun-string-or (shimbun-header-id header)))
- ;; Force `princ' to work in the current buffer.
- (standard-output (current-buffer))
- (xref (nnshimbun-string-or (shimbun-header-xref header)))
- (start (point)))
- (and (stringp id)
- header-id
- (string-equal id header-id)
- (setq id nil))
- (princ number)
- (insert
- "\t"
- (nnshimbun-string-or (shimbun-header-subject header) "(none)") "\t"
- (nnshimbun-string-or (shimbun-header-from header) "(nobody)") "\t"
- (nnshimbun-string-or (shimbun-header-date header) (message-make-date))
- "\t"
- (or header-id (nnmail-message-id)) "\t"
- (or (shimbun-header-references header) "") "\t")
- (princ (or (shimbun-header-chars header) 0))
- (insert "\t")
- (princ (or (shimbun-header-lines header) 0))
- (insert "\t")
- (if xref
- (progn
- (insert "Xref: " xref "\t")
- (when id
- (insert "X-Nnshimbun-Id: " id "\t")))
- (when id
- (insert "\tX-Nnshimbun-Id: " id "\t")))
- ;; Replace newlines with spaces in the current NOV line.
- (while (progn
- (forward-line 0)
- (> (point) start))
- (backward-delete-char 1)
- (insert " "))
- (forward-line 1)))
-
-(defun nnshimbun-generate-nov-database (group)
- (when (nnshimbun-possibly-change-group group)
- (with-current-buffer (nnshimbun-open-nov group)
- (goto-char (point-max))
- (forward-line -1)
- (let* ((i (or (ignore-errors (read (current-buffer))) 0))
- (name (concat "nnshimbun+" (nnshimbun-current-server) ":" group))
- (pre-fetch (nnshimbun-find-parameter name 'prefetch-articles t)))
- (dolist (header
- (shimbun-headers nnshimbun-shimbun
- (nnshimbun-find-parameter name
- 'index-range t)))
- (unless (nnshimbun-search-id group (shimbun-header-id header))
- (goto-char (point-max))
- (nnshimbun-insert-nov (setq i (1+ i)) header)
- (when pre-fetch
- (with-temp-buffer
- (nnshimbun-request-article-1 i group nil (current-buffer)))))))
- (nnshimbun-write-nov group))))
-
-(defun nnshimbun-replace-nov-entry (group article header &optional id)
- (with-current-buffer (nnshimbun-open-nov group)
- (when (nnheader-find-nov-line article)
- (delete-region (point) (progn (forward-line 1) (point)))
- (nnshimbun-insert-nov article header id))))
-
-(defun nnshimbun-search-id (group id)
- (with-current-buffer (nnshimbun-open-nov group)
- (goto-char (point-min))
- (let (found)
- (while (and (not found)
- (search-forward id nil t)) ; We find the ID.
- ;; And the id is in the fourth field.
- (if (not (and (search-backward "\t" nil t 4)
- (not (search-backward "\t" (gnus-point-at-bol) t))))
- (forward-line 1)
- (forward-line 0)
- (setq found t)))
- (unless found
- (goto-char (point-min))
- (setq id (concat "X-Nnshimbun-Id: " id))
- (while (and (not found)
- (search-forward id nil t))
- (if (not (search-backward "\t" (gnus-point-at-bol) t 8))
- (forward-line 1)
- (forward-line 0)
- (setq found t))))
- (when found
- (ignore-errors (read (current-buffer)))))))
-
-;; This function is defined as an alternative of `nnheader-parse-nov',
-;; in order to keep compatibility between T-gnus and Oort Gnus.
-(defun nnshimbun-parse-nov ()
- (let ((eol (gnus-point-at-eol)))
- (let ((number (nnheader-nov-read-integer))
- (subject (nnheader-nov-field))
- (from (nnheader-nov-field))
- (date (nnheader-nov-field))
- (id (nnheader-nov-read-message-id))
- (refs (nnheader-nov-field))
- (chars (nnheader-nov-read-integer))
- (lines (nnheader-nov-read-integer))
- (xref (unless (eq (char-after) ?\n)
- (when (looking-at "Xref: ")
- (goto-char (match-end 0)))
- (nnheader-nov-field)))
- (extra (nnheader-nov-parse-extra)))
- (shimbun-make-header number subject from date
- (or (cdr (assq 'X-Nnshimbun-Id extra)) id)
- refs chars lines xref))))
-
-(defsubst nnshimbun-nov-buffer-name (&optional group)
- (format " *nnshimbun overview %s %s*"
- (nnshimbun-current-server)
- (or group (nnshimbun-current-group))))
-
-(defsubst nnshimbun-nov-file-name (&optional group)
- (nnmail-group-pathname (or group (nnshimbun-current-group))
- (nnshimbun-server-directory)
- nnshimbun-nov-file-name))
-
-(defun nnshimbun-open-nov (group)
- (let ((buffer (nnshimbun-nov-buffer-name group)))
- (unless (gnus-buffer-live-p buffer)
- (with-current-buffer (gnus-get-buffer-create buffer)
- (erase-buffer)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (nov (nnshimbun-nov-file-name group)))
- (when (file-exists-p nov)
- (nnheader-insert-file-contents nov)))
- (set-buffer-modified-p nil)))
- buffer))
-
-(defun nnshimbun-write-nov (group &optional close)
- (let ((buffer (nnshimbun-nov-buffer-name group)))
- (when (gnus-buffer-live-p buffer)
- (with-current-buffer buffer
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (nov (nnshimbun-nov-file-name group)))
- (when (and (buffer-modified-p)
- (or (> (buffer-size) 0)
- (file-exists-p nov)))
- (nnmail-write-region 1 (point-max) nov nil 'nomesg)
- (set-buffer-modified-p nil))))
- (when close
- (kill-buffer buffer)))))
-
-(deffoo nnshimbun-request-expire-articles (articles group
- &optional server force)
- "Do expiration for the specified ARTICLES in the nnshimbun GROUP.
-Notice that nnshimbun does not actually delete any articles, it just
-delete the corresponding entries in the NOV database locally. The
-optional fourth argument FORCE is ignored."
- (when (nnshimbun-possibly-change-group group server)
- (let* ((expirable (copy-sequence articles))
- (name (concat "nnshimbun+" (nnshimbun-current-server) ":" group))
- ;; If the group's parameter `expiry-wait' is non-nil, the
- ;; value of the option `nnmail-expiry-wait' will be bound
- ;; to that value, and the value of the option
- ;; `nnmail-expiry-wait-function' will be bound to nil. See
- ;; the source code of `gnus-summary-expire-articles' how
- ;; does it work. If the group's parameter is not specified
- ;; by user, the shimbun's default value will be used.
- (expiry-wait
- (or (nnshimbun-find-parameter name 'expiry-wait t)
- (shimbun-article-expiration-days nnshimbun-shimbun)))
- (nnmail-expiry-wait (or expiry-wait nnmail-expiry-wait))
- (nnmail-expiry-wait-function (if expiry-wait
- nil
- nnmail-expiry-wait-function))
- article end time)
- (with-current-buffer (nnshimbun-open-nov group)
- (while expirable
- (setq article (pop expirable))
- (when (and (nnheader-find-nov-line article)
- (setq end (gnus-point-at-eol))
- (not (= (point-max) (1+ end))))
- (setq time (and (search-forward "\t" end t)
- (search-forward "\t" end t)
- (search-forward "\t" end t)
- (parse-time-string
- (buffer-substring
- (point)
- (if (search-forward "\t" end t)
- (1- (point))
- end)))))
- (when (if (setq time (condition-case nil
- (apply 'encode-time time)
- (error nil)))
- (nnmail-expired-article-p name time nil)
- ;; Inhibit expiration if there's no parsable date
- ;; and the following option is non-nil.
- (not nnshimbun-keep-unparsable-dated-articles))
- (forward-line 0)
- (delete-region (point) (1+ end))
- (setq articles (delq article articles)))))
- (nnshimbun-write-nov group))
- articles)))
-
-
-;;; shimbun-gnus-mua
-(luna-define-class shimbun-gnus-mua (shimbun-mua) ())
-
-(luna-define-method shimbun-mua-search-id ((mua shimbun-gnus-mua) id)
- (nnshimbun-search-id
- (shimbun-current-group-internal (shimbun-mua-shimbun-internal mua))
- id))
-
-
-;;; Command to create nnshimbun group
-(defvar nnshimbun-server-history nil)
-
-;;;###autoload
-(defun gnus-group-make-shimbun-group ()
- "Create a nnshimbun group."
- (interactive)
- (let* ((minibuffer-setup-hook
- (append minibuffer-setup-hook '(beginning-of-line)))
- (alist
- (apply 'nconc
- (mapcar
- (lambda (d)
- (and (stringp d)
- (file-directory-p d)
- (delq nil
- (mapcar
- (lambda (f)
- (and (string-match "^sb-\\(.*\\)\\.el$" f)
- (list (match-string 1 f))))
- (directory-files d)))))
- load-path)))
- (server (completing-read
- "Shimbun address: "
- alist nil t
- (or (car nnshimbun-server-history)
- (caar alist))
- 'nnshimbun-server-history))
- (groups)
- (nnshimbun-pre-fetch-article))
- (if (setq groups (shimbun-groups (shimbun-open server)))
- (gnus-group-make-group
- (completing-read "Group name: " (mapcar 'list groups) nil t nil)
- (list 'nnshimbun server))
- (error "%s" "Can't find group"))))
-
-
-(provide 'nnshimbun)
-
-;;; nnshimbun.el ends here
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nnoo)
(require 'message)
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nnheader)
(require 'nntp)
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nnheader)
(require 'nnoo)
(goto-char pos)
(if (looking-at (regexp-quote command))
(delete-region pos (progn (forward-line 1)
- (gnus-point-at-bol)))))))
+ (point-at-bol)))))))
(nnheader-report 'nntp "Couldn't open connection to %s."
nntp-address))))
(goto-char pos)
(if (looking-at (regexp-quote command))
(delete-region pos (progn (forward-line 1)
- (gnus-point-at-bol))))
+ (point-at-bol))))
)))
(nnheader-report 'nntp "Couldn't open connection to %s."
nntp-address))))
(set-buffer buffer)
(goto-char pos)
(if (looking-at (regexp-quote command))
- (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
+ (delete-region pos (progn (forward-line 1) (point-at-bol))))
)))
(nnheader-report 'nntp "Couldn't open connection to %s."
nntp-address))))
(let ((timer
(and nntp-connection-timeout
- (nnheader-run-at-time
+ (run-at-time
nntp-connection-timeout nil
'(lambda ()
(let ((process (nntp-find-connection
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
"^2.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point) (gnus-point-at-eol))))))
+ (buffer-substring (point) (point-at-eol))))))
;;; Internal functions.
(let* ((pbuffer (nntp-make-process-buffer buffer))
(timer
(and nntp-connection-timeout
- (nnheader-run-at-time
+ (run-at-time
nntp-connection-timeout nil
`(lambda ()
(nntp-kill-buffer ,pbuffer)))))
;; doesn't trigger after-change-functions.
(unless nntp-async-timer
(setq nntp-async-timer
- (nnheader-run-at-time 1 1 'nntp-async-timer-handler)))
+ (run-at-time 1 1 'nntp-async-timer-handler)))
(add-to-list 'nntp-async-process-list process))
(defun nntp-async-timer-handler ()
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nnoo)
(require 'message)
(looking-at
"[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
(goto-char (match-end 0))
- (unless (search-forward "\t" (gnus-point-at-eol) 'move)
+ (unless (search-forward "\t" (point-at-eol) 'move)
(insert "\t"))
;; Remove any spaces at the beginning of the Xref field.
;; component server prefix.
(save-restriction
(narrow-to-region (point)
- (or (search-forward "\t" (gnus-point-at-eol) t)
- (gnus-point-at-eol)))
+ (or (search-forward "\t" (point-at-eol) t)
+ (point-at-eol)))
(goto-char (point-min))
(when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
(replace-match "" t t))
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nnoo)
(require 'message)
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nnoo)
(require 'message)
;;; Code:
-(autoload 'run-at-time "timer")
+(if (featurep 'xemacs)
+ (require 'run-at-time)
+ (autoload 'run-at-time "timer"))
(eval-when-compile
(require 'cl))
(symbol-value (intern-soft key password-data)))
(read-passwd prompt)))
-(eval-when-compile
- (defvar itimer-process)
- (defvar itimer-timer)
- (autoload 'delete-itimer "itimer")
- (autoload 'itimer-driver-start "itimer")
- (autoload 'itimer-value "itimer")
- (autoload 'set-itimer-function "itimer")
- (autoload 'set-itimer-function-arguments "itimer")
- (autoload 'set-itimer-restart "itimer")
- (autoload 'start-itimer "itimer"))
-
-(eval-and-compile
- (defalias
- 'password-run-at-time
- (if (featurep 'xemacs)
- (if (condition-case nil
- (progn
- (unless (or itimer-process itimer-timer)
- (itimer-driver-start))
- ;; Check whether there is a bug to which the difference of
- ;; the present time and the time when the itimer driver was
- ;; woken up is subtracted from the initial itimer value.
- (let* ((inhibit-quit t)
- (ctime (current-time))
- (itimer-timer-last-wakeup
- (prog1
- ctime
- (setcar ctime (1- (car ctime)))))
- (itimer-list nil)
- (itimer (start-itimer "password-run-at-time" 'ignore 5)))
- (sleep-for 0.1) ;; Accept the timeout interrupt.
- (prog1
- (> (itimer-value itimer) 0)
- (delete-itimer itimer))))
- (error nil))
- (lambda (time repeat function &rest args)
- "Emulating function run as `run-at-time'.
-TIME should be nil meaning now, or a number of seconds from now.
-Return an itimer object which can be used in either `delete-itimer'
-or `cancel-timer'."
- (apply #'start-itimer "password-run-at-time"
- function (if time (max time 1e-9) 1e-9)
- repeat nil t args))
- (lambda (time repeat function &rest args)
- "Emulating function run as `run-at-time' in the right way.
-TIME should be nil meaning now, or a number of seconds from now.
-Return an itimer object which can be used in either `delete-itimer'
-or `cancel-timer'."
- (let ((itimers (list nil)))
- (setcar
- itimers
- (apply #'start-itimer "password-run-at-time"
- (lambda (itimers repeat function &rest args)
- (let ((itimer (car itimers)))
- (if repeat
- (progn
- (set-itimer-function
- itimer
- (lambda (itimer repeat function &rest args)
- (set-itimer-restart itimer repeat)
- (set-itimer-function itimer function)
- (set-itimer-function-arguments itimer args)
- (apply function args)))
- (set-itimer-function-arguments
- itimer
- (append (list itimer repeat function) args)))
- (set-itimer-function
- itimer
- (lambda (itimer function &rest args)
- (delete-itimer itimer)
- (apply function args)))
- (set-itimer-function-arguments
- itimer
- (append (list itimer function) args)))))
- 1e-9 (if time (max time 1e-9) 1e-9)
- nil t itimers repeat function args)))))
- 'run-at-time)))
-
(defun password-cache-remove (key)
"Remove password indexed by KEY from password cache.
This is typically run be a timer setup from `password-cache-add',
seconds."
(set (intern key password-data) password)
(when password-cache-expiry
- (password-run-at-time password-cache-expiry nil
- #'password-cache-remove
- key))
+ (run-at-time password-cache-expiry nil
+ #'password-cache-remove
+ key))
nil)
(provide 'password)
(eval-when-compile
(require 'cl)
- (defvar message-posting-charset)
- (unless (fboundp 'with-syntax-table) ; not in Emacs 20
- (defmacro with-syntax-table (table &rest body)
- "Evaluate BODY with syntax table of current buffer set to TABLE.
-The syntax table of the current buffer is saved, BODY is evaluated, and the
-saved table is restored, even in case of an abnormal exit.
-Value is what BODY returns."
- (let ((old-table (make-symbol "table"))
- (old-buffer (make-symbol "buffer")))
- `(let ((,old-table (syntax-table))
- (,old-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-syntax-table ,table)
- ,@body)
- (save-current-buffer
- (set-buffer ,old-buffer)
- (set-syntax-table ,old-table))))))))
+ (defvar message-posting-charset))
(require 'qp)
(require 'mm-util)
(require 'base64)
(autoload 'mm-body-7-or-8 "mm-bodies")
-(eval-and-compile
- ;; Avoid gnus-util for mm- code.
- (defalias 'rfc2047-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
-
- (defalias 'rfc2047-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
(defvar rfc2047-header-encoding-alist
'(("Newsgroups" . nil)
("Followup-To" . nil)
(progn
(forward-line 1)
(if (re-search-forward "^[^ \n\t]" nil t)
- (rfc2047-point-at-bol)
+ (point-at-bol)
(point-max))))
(goto-char (point-min)))
(t 8)))
(pre (- b (save-restriction
(widen)
- (rfc2047-point-at-bol))))
+ (point-at-bol))))
;; encoded-words must not be longer than 75 characters,
;; including charset, encoding etc. This leaves us with
;; 75 - (length start) - 2 - 2 characters. The last 2 is for
(first t)
(bol (save-restriction
(widen)
- (rfc2047-point-at-bol))))
+ (point-at-bol))))
(while (not (eobp))
(when (and (or break qword-break)
(> (- (point) bol) 76))
(goto-char (point-min))
(let ((bol (save-restriction
(widen)
- (rfc2047-point-at-bol)))
- (eol (rfc2047-point-at-eol)))
+ (point-at-bol)))
+ (eol (point-at-eol)))
(forward-line 1)
(while (not (eobp))
(if (and (looking-at "[ \t]")
- (< (- (rfc2047-point-at-eol) bol) 76))
+ (< (- (point-at-eol) bol) 76))
(delete-region eol (progn
(goto-char eol)
(skip-chars-forward "\r\n")
(point)))
- (setq bol (rfc2047-point-at-bol)))
- (setq eol (rfc2047-point-at-eol))
+ (setq bol (point-at-bol)))
+ (setq eol (point-at-eol))
(forward-line 1)))))
(defun rfc2047-b-encode-region (b e)
(narrow-to-region (goto-char b) e)
(let ((bol (save-restriction
(widen)
- (rfc2047-point-at-bol))))
+ (point-at-bol))))
(quoted-printable-encode-region
b e nil
;; = (\075), _ (\137), ? (\077) are used in the encoded word.
;;; Code:
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
-
-(eval-when-compile (require 'cl))
(require 'ietf-drums)
(require 'rfc2047)
(autoload 'mm-encode-body "mm-bodies")
--- /dev/null
+;;; run-at-time.el --- A non-buggy version of the run-at-time function
+
+;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc.
+
+;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
+
+;; 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 2, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; XEmacs has a buggy version of run-at-time. This file defines a
+;; non-buggy version of the same.
+
+(defvar run-at-time-saved (symbol-function 'run-at-time))
+
+(require 'itimer)
+
+(eval-and-compile
+ (when (featurep 'xemacs)
+ (defalias
+ 'run-at-time
+ (if (condition-case nil
+ (progn
+ (unless (or itimer-process itimer-timer)
+ (itimer-driver-start))
+ ;; Check whether there is a bug to which the difference of
+ ;; the present time and the time when the itimer driver was
+ ;; woken up is subtracted from the initial itimer value.
+ (let* ((inhibit-quit t)
+ (ctime (current-time))
+ (itimer-timer-last-wakeup
+ (prog1
+ ctime
+ (setcar ctime (1- (car ctime)))))
+ (itimer-list nil)
+ (itimer (start-itimer "fixed-run-at-time" 'ignore 5)))
+ (sleep-for 0.1) ;; Accept the timeout interrupt.
+ (prog1
+ (> (itimer-value itimer) 0)
+ (delete-itimer itimer))))
+ (error nil))
+ (lambda (time repeat function &rest args)
+ "Emulating function run as `run-at-time'.
+TIME should be nil meaning now, or a number of seconds from now.
+Return an itimer object which can be used in either `delete-itimer'
+or `cancel-timer'."
+ (apply #'start-itimer "fixed-run-at-time"
+ function (if time (max time 1e-9) 1e-9)
+ repeat nil t args))
+ (lambda (time repeat function &rest args)
+ "Emulating function run as `run-at-time' in the right way.
+TIME should be nil meaning now, or a number of seconds from now.
+Return an itimer object which can be used in either `delete-itimer'
+or `cancel-timer'."
+ (let ((itimers (list nil)))
+ (setcar
+ itimers
+ (apply #'start-itimer "fixed-run-at-time"
+ (lambda (itimers repeat function &rest args)
+ (let ((itimer (car itimers)))
+ (if repeat
+ (progn
+ (set-itimer-function
+ itimer
+ (lambda (itimer repeat function &rest args)
+ (set-itimer-restart itimer repeat)
+ (set-itimer-function itimer function)
+ (set-itimer-function-arguments itimer args)
+ (apply function args)))
+ (set-itimer-function-arguments
+ itimer
+ (append (list itimer repeat function) args)))
+ (set-itimer-function
+ itimer
+ (lambda (itimer function &rest args)
+ (delete-itimer itimer)
+ (apply function args)))
+ (set-itimer-function-arguments
+ itimer
+ (append (list itimer function) args)))))
+ 1e-9 (if time (max time 1e-9) 1e-9)
+ nil t itimers repeat function args))))))))
+
+(provide 'run-at-time)
+
+;;; run-at-time.el ends here
(caddr curkey)
(smime-get-certfiles keyfile otherkeys)))))
-;; Use mm-util?
-(eval-and-compile
- (defalias 'smime-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
(defun smime-buffer-as-string-region (b e)
"Return each line in region between B and E as a list of strings."
(save-excursion
(goto-char b)
(let (res)
(while (< (point) e)
- (let ((str (buffer-substring (point) (smime-point-at-eol))))
+ (let ((str (buffer-substring (point) (point-at-eol))))
(unless (string= "" str)
(push str res)))
(forward-line))
(defvar spam-stat-buffer-name " *spam stat buffer*"
"Name of the `spam-stat-buffer'.")
-;; Functions missing in Emacs 20
-
-(when (memq nil (mapcar 'fboundp
- '(gethash hash-table-count make-hash-table
- mapc puthash)))
- (require 'cl)
- (unless (fboundp 'puthash)
- ;; alias puthash is missing from Emacs 20 cl-extra.el
- (defalias 'puthash 'cl-puthash)))
-
-(eval-when-compile
- (unless (fboundp 'with-syntax-table)
- ;; Imported from Emacs 21.2
- (defmacro with-syntax-table (table &rest body) "\
-Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
-The syntax table of the current buffer is saved, BODY is evaluated, and the
-saved table is restored, even in case of an abnormal exit.
-Value is what BODY returns."
- (let ((old-table (make-symbol "table"))
- (old-buffer (make-symbol "buffer")))
- `(let ((,old-table (syntax-table))
- (,old-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-syntax-table (copy-syntax-table ,table))
- ,@body)
- (save-current-buffer
- (set-buffer ,old-buffer)
- (set-syntax-table ,old-table))))))))
-
;; Hooking into Gnus
(defun spam-stat-store-current-buffer ()
(apply 'spam-ham-move-routine (car groups))
(spam-ham-copy-or-move-routine nil groups)))
-(eval-and-compile
- (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
(defun spam-get-article-as-string (article)
(let ((article-buffer (spam-get-article-as-buffer article))
article-string)
;; check the return now (we're back in the temp buffer)
(goto-char (point-min))
(if (not (eobp))
- (setq category (buffer-substring (point) (spam-point-at-eol))))
+ (setq category (buffer-substring (point) (point-at-eol))))
(when (not (zerop (length category))) ; we need a category here
(if spam-ifile-all-categories
(setq return category)
(with-temp-buffer
(insert-file-contents file)
(while (not (eobp))
- (setq address (buffer-substring (point) (spam-point-at-eol)))
+ (setq address (buffer-substring (point) (point-at-eol)))
(forward-line 1)
;; insert the e-mail address if detected, otherwise the raw data
(unless (zerop (length address))
echo * (add-to-list 'load-path "/Path/to/gnus/lisp")\r
echo * (if (featurep 'xemacs)\r
echo * (add-to-list 'Info-directory-list "c:/Path/to/gnus/texi/")\r
-echo * (add-to-list 'Info-default-directory-list "c:/Path/to/gnus/texi/")\r
+echo * (add-to-list 'Info-default-directory-list "c:/Path/to/gnus/texi/"))\r
echo * (require 'gnus-load)\r
echo *\r
echo * Replace c:/Path/to/gnus with the Path where your new Gnus is (that's here\r
projects / elisp / gnus.git- / commitdiff