From: yamaoka Date: Tue, 6 Jan 2004 10:19:05 +0000 (+0000) Subject: * lisp/gnus-clfns.el: Abolish. X-Git-Tag: t-gnus-6_17_4-quimby-~1163 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=288df404798143bcebde31f44f2041f786424fa6;p=elisp%2Fgnus.git- * lisp/gnus-clfns.el: Abolish. * lisp/nnshimbun.el: Abolish. * lisp/dgnushack.el: Allow loading dgnushack.el w/o dgnuspath.el. Synch to No Gnus 200401060628. --- diff --git a/ChangeLog b/ChangeLog index 9a9e3a0..6d5cce6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2004-01-06 Katsumi Yamaoka + + * 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 + + * make.bat: Add missing parens. From Robert Marshall + . + 2004-01-05 Katsumi Yamaoka * aclocal.m4 (AC_CHECK_EMACS_FLAVOR): Don't check for Mule 2. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 77c7d25..ce9259e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,199 @@ +2004-01-06 Lars Magne Ingebrigtsen + + * 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,Ad(Bsterer + + * mml.el (mml-minibuffer-read-disposition): Show attachment type + in prompt (tiny change) + +2004-01-06 Steve Youngs + + * 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 + + * 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 + + * password.el: Only autoload `run-at-time' if not XEmacs. + Only autoload the itimer functions if XEmacs. + +2004-01-06 Katsumi Yamaoka + + * 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 + + * gnus-art.el (gnus-read-string): Remove. + (gnus-summary-pipe-to-muttprint): Replace gnus-read-string with + read-string. + +2004-01-05 Teodor Zlatanov + + * 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 + + * 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 + + * gnus-art.el (gnus-treat-ansi-sequences, + article-treat-ansi-sequences): New variable and function. + Suggested by Dan Jacobson . + + * gnus-sum.el (gnus-summary-wash-map, gnus-summary-make-menu-bar): + Use it. + +2004-01-05 Jesper Harder + + * 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 * ntlm.el (ntlm-string-as-unibyte): New macro. diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 0e4ecf3..2a7b7b2 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -211,7 +211,9 @@ It has already been fixed in XEmacs since 1999-12-06." (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) @@ -273,8 +275,6 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (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'. @@ -419,11 +419,6 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (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) @@ -439,6 +434,7 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (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") @@ -543,7 +539,8 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. "")) '("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")) diff --git a/lisp/dns.el b/lisp/dns.el index 5dc49b7..3f3d1bd 100644 --- a/lisp/dns.el +++ b/lisp/dns.el @@ -309,8 +309,8 @@ If TCP-P, the first two bytes of the package with be the length field." (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) diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el index f72bf5b..db24c4e 100644 --- a/lisp/flow-fill.el +++ b/lisp/flow-fill.el @@ -70,17 +70,6 @@ RFC 2646 suggests 66 characters for readability." (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)) @@ -142,8 +131,8 @@ RFC 2646 suggests 66 characters for readability." (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 diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index e0d2129..e0e952b 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -26,7 +26,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-cache) @@ -1495,7 +1494,7 @@ and that there are no duplicates." (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))) @@ -2251,7 +2250,7 @@ The following commands are available: (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 () @@ -2888,7 +2887,7 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) (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))) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index c1861d6..253adb3 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -60,6 +60,7 @@ (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." @@ -1204,6 +1205,14 @@ See Info node `(gnus)Customizing Articles' for details." :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) @@ -1523,6 +1532,7 @@ This requires GNU Libidn, and by default only enabled if it is found." (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 @@ -1760,7 +1770,7 @@ always hide." (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) @@ -1886,7 +1896,7 @@ always hide." (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) @@ -1907,7 +1917,7 @@ always hide." (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 @@ -1918,7 +1928,7 @@ always hide." (progn (forward-char gnus-article-normalized-header-length) (point)) - (gnus-point-at-eol) + (point-at-eol) 'invisible t)) (t ;; Do nothing. @@ -1999,6 +2009,14 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (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 @@ -2105,7 +2123,7 @@ unfolded." (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))) @@ -2147,7 +2165,7 @@ unfolded." (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)))))) @@ -2918,11 +2936,11 @@ should replace the \"Date:\" one, or should be added below it." (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. @@ -2954,7 +2972,7 @@ should replace the \"Date:\" one, or should be added below it." (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) @@ -3131,7 +3149,7 @@ is to run." (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." @@ -3465,17 +3483,9 @@ The directory to save in defaults to `gnus-article-save-directory'." (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)) @@ -3598,8 +3608,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (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) @@ -3666,6 +3676,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-monafy article-hide-boring-headers article-treat-overstrike + article-treat-ansi-sequences article-fill-long-lines article-capitalize-sentences article-remove-cr @@ -3778,6 +3789,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["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] @@ -4853,11 +4865,11 @@ N is the numerical prefix." (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)) @@ -5135,7 +5147,7 @@ If displaying \"text/html\" is discouraged \(see ',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 @@ -5159,7 +5171,7 @@ If displaying \"text/html\" is discouraged \(see ',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 @@ -5446,9 +5458,9 @@ not have a face in `gnus-article-boring-faces'." "Read article specified by message-id around point." (interactive) (save-excursion - (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t) - (re-search-forward "]+" (gnus-point-at-eol) t) + (re-search-backward "[ \t]\\|^" (point-at-bol) t) + (re-search-forward "]+" (point-at-eol) t) (let ((msg-id (concat "<" (match-string 0) ">"))) (set-buffer gnus-summary-buffer) (gnus-summary-refer-article msg-id)) @@ -6012,7 +6024,7 @@ groups." (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) @@ -7026,7 +7038,7 @@ specified by `gnus-button-alist'." (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)))) @@ -7220,7 +7232,7 @@ specified by `gnus-button-alist'." (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 @@ -7263,7 +7275,7 @@ specified by `gnus-button-alist'." (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 @@ -7626,7 +7638,7 @@ For example: (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 diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 0484732..c4b27ee 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -29,7 +29,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-int) @@ -528,7 +527,7 @@ Returns the list of articles removed." (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) diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 2028d78..22b848d 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -374,7 +374,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (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)) @@ -728,7 +728,7 @@ See also the documentation for `gnus-article-highlight-citation'." ;; 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. @@ -744,7 +744,7 @@ See also the documentation for `gnus-article-highlight-citation'." ;; 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))) diff --git a/lisp/gnus-clfns.el b/lisp/gnus-clfns.el deleted file mode 100644 index db33634..0000000 --- a/lisp/gnus-clfns.el +++ /dev/null @@ -1,432 +0,0 @@ -;;; gnus-clfns.el --- compiler macros for emulating cl functions - -;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. - -;; Author: Kastsumi Yamaoka -;; 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 diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el index 3d943b6..a8515b8 100644 --- a/lisp/gnus-demon.el +++ b/lisp/gnus-demon.el @@ -107,7 +107,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (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 diff --git a/lisp/gnus-diary.el b/lisp/gnus-diary.el index dafb8c3..b7c3148 100644 --- a/lisp/gnus-diary.el +++ b/lisp/gnus-diary.el @@ -406,7 +406,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields." (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 () diff --git a/lisp/gnus-dired.el b/lisp/gnus-dired.el index 1fa657f..3937874 100644 --- a/lisp/gnus-dired.el +++ b/lisp/gnus-dired.el @@ -72,7 +72,7 @@ (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 diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index a0774ef..1d87290 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -76,7 +76,7 @@ ;; 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 @@ -153,7 +153,7 @@ (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 diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 4bd23d4..196000e 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -38,8 +38,7 @@ (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) '("--**-" . "-----") '("**" "--"))) @@ -65,12 +64,6 @@ ;;; 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 @@ -166,16 +159,6 @@ "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")) diff --git a/lisp/gnus-gl.el b/lisp/gnus-gl.el index 7a989e6..371c4d1 100644 --- a/lisp/gnus-gl.el +++ b/lisp/gnus-gl.el @@ -851,7 +851,7 @@ If prefix argument ALL is non-nil, all articles are marked as read." (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)))) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index c0d8f01..526a1e9 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1163,7 +1163,7 @@ Also see the `gnus-group-use-permanent-levels' variable." (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) @@ -1496,7 +1496,7 @@ if it is a string, only list groups matching REGEXP." "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)) @@ -1632,24 +1632,24 @@ already." (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)) diff --git a/lisp/gnus-ml.el b/lisp/gnus-ml.el index 25f6685..7179fe2 100644 --- a/lisp/gnus-ml.el +++ b/lisp/gnus-ml.el @@ -102,7 +102,7 @@ If FORCE is non-nil, replace the old ones." ;; 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 diff --git a/lisp/gnus-namazu.el b/lisp/gnus-namazu.el index def49fc..fec26cb 100644 --- a/lisp/gnus-namazu.el +++ b/lisp/gnus-namazu.el @@ -1,6 +1,7 @@ ;;; gnus-namazu.el --- Search mail with Namazu -*- coding: iso-2022-7bit; -*- -;; Copyright (C) 2000,2001,2002,2003 TSUCHIYA Masatoshi +;; Copyright (C) 2000, 2001, 2002, 2003, 2004 +;; TSUCHIYA Masatoshi ;; Author: TSUCHIYA Masatoshi ;; Keywords: mail searching namazu @@ -287,8 +288,8 @@ options make any sense in this context." (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) @@ -376,7 +377,7 @@ options make any sense in this context." group (string-to-number (buffer-substring-no-properties (point) - (gnus-point-at-eol)))) + (point-at-eol)))) articles)) (forward-line 1)) (nreverse articles)))) diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index 086b9f4..e36c25d 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -29,7 +29,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'nnmail) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index 900eeab..32d92bf 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -129,13 +129,6 @@ way." :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)) diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index 3727a4f..739d073 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -128,7 +128,7 @@ It accepts the same format specs that `gnus-summary-line-format' does." ;; 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)))) @@ -361,7 +361,7 @@ This must be bound to a button-down mouse event." ;; 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)))) @@ -725,7 +725,7 @@ Two predefined functions are available: (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) @@ -749,7 +749,7 @@ Two predefined functions are available: (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 ? ))))) @@ -1027,11 +1027,11 @@ The following commands are available: (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) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 0e9aaee..e88ae87 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -28,7 +28,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-sum) @@ -1157,9 +1156,9 @@ If FORMAT, also format the current score file." (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) @@ -1889,7 +1888,7 @@ score in `gnus-newsgroup-scored' by SCORE." (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)) @@ -2059,7 +2058,7 @@ score in `gnus-newsgroup-scored' by SCORE." (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 @@ -2149,7 +2148,7 @@ score in `gnus-newsgroup-scored' by SCORE." (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 @@ -2237,7 +2236,7 @@ score in `gnus-newsgroup-scored' by SCORE." 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. diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index a45f1ca..ada4905 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -321,7 +321,7 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." (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) @@ -334,14 +334,14 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." ;; 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)))) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index bfc3d08..17e385a 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -342,13 +342,13 @@ The following commands are available: (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) @@ -896,7 +896,7 @@ buffer. (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))))))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 584cbfa..21bd7b4 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2091,7 +2091,7 @@ newsgroup." (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))) @@ -2123,7 +2123,7 @@ newsgroup." (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))))) @@ -2443,7 +2443,7 @@ If FORCE is non-nil, the .newsrc file is read." ;; 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))) @@ -2514,8 +2514,8 @@ If FORCE is non-nil, the .newsrc file is read." ;; 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 @@ -2624,9 +2624,9 @@ If FORCE is non-nil, the .newsrc file is read." (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)) ?!) @@ -2946,7 +2946,7 @@ If FORCE is non-nil, the .newsrc file is read." (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 () diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 2fb0c85..73be7cc 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -30,7 +30,6 @@ (eval-when-compile (require 'cl) - (require 'gnus-clfns) (defvar tool-bar-map)) (require 'gnus) @@ -1861,6 +1860,7 @@ increase the score of each group you read." "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 @@ -2177,6 +2177,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["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] @@ -3992,7 +3993,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; 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) @@ -4181,7 +4182,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (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)))) @@ -4363,9 +4364,9 @@ If LINE, insert the rebuilt thread starting on line LINE." (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) @@ -5948,7 +5949,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (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) @@ -5976,9 +5977,9 @@ the subject line on." (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))) @@ -6697,7 +6698,7 @@ The state which existed when entering the ephemeral is reset." (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 () @@ -10012,7 +10013,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (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)) @@ -10536,7 +10537,7 @@ Returns nil if no thread was there to be shown." (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 @@ -11132,7 +11133,7 @@ If REVERSE, save parts that do not match TYPE." (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)) @@ -11292,8 +11293,8 @@ If REVERSE, save parts that do not match TYPE." ;; Added by Per Abrahamsen . (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 . (from (if (get-text-property beg gnus-mouse-face-prop) beg @@ -11342,7 +11343,7 @@ If REVERSE, save parts that do not match TYPE." (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)) @@ -11357,7 +11358,7 @@ If REVERSE, save parts that do not match TYPE." (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)))))) @@ -11627,7 +11628,7 @@ treated as multipart/mixed." (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)) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 2352e2b..87a06c7 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -28,7 +28,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-group) @@ -105,16 +104,16 @@ See Info node `(gnus)Formatting Variables'." (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." @@ -127,7 +126,7 @@ See Info node `(gnus)Formatting Variables'." (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) @@ -1137,7 +1136,7 @@ articles in the topic and its subtopics." (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))) diff --git a/lisp/gnus-undo.el b/lisp/gnus-undo.el index f022926..816e575 100644 --- a/lisp/gnus-undo.el +++ b/lisp/gnus-undo.el @@ -113,7 +113,7 @@ ;; 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))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index d3bad27..5427912 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -130,35 +130,6 @@ (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 @@ -183,7 +154,7 @@ ;; 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) @@ -246,7 +217,7 @@ is slower." (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))))) @@ -1286,32 +1257,12 @@ SPEC is a predicate specifier that contains stuff like `or', `and', `(,(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 ": ")) @@ -1521,7 +1472,7 @@ predicate on the elements." ((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 ")") ""))) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index de66b8d..7a55ce5 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -509,11 +509,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "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)))) @@ -846,7 +846,7 @@ When called interactively, prompt for REGEXP." (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)) @@ -1767,7 +1767,7 @@ Gnus might fail to display all of it.") ;; 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)))) @@ -2099,8 +2099,7 @@ If no file has been included, the user will be asked for a file." (when (not gnus-uu-post-separate-description) (set-buffer-modified-p nil) - (when (fboundp 'bury-buffer) - (bury-buffer))))) + (bury-buffer)))) (provide 'gnus-uu) diff --git a/lisp/gnus-vers.el b/lisp/gnus-vers.el index 0c1fa27..f1a32f5 100644 --- a/lisp/gnus-vers.el +++ b/lisp/gnus-vers.el @@ -28,7 +28,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'poe) (require 'product) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 6fff59e..556fc9e 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -40,6 +40,7 @@ (defvar menu-bar-mode (featurep 'menubar)) (require 'messagexmas) (require 'wid-edit) +(require 'run-at-time) (defgroup gnus-xmas nil "XEmacsoid support for Gnus" @@ -104,27 +105,13 @@ Possibly the `etc' directory has not been installed."))) (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))) @@ -401,10 +388,6 @@ call it with the value of the `gnus-data' text property." (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)) @@ -422,7 +405,10 @@ call it with the value of the `gnus-data' text property." '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." @@ -451,11 +437,6 @@ call it with the value of the `gnus-data' text property." (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. @@ -814,7 +795,7 @@ XEmacs compatibility workaround." (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 @@ -946,31 +927,6 @@ Warning: Don't insert text immediately after the image." 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)) diff --git a/lisp/gnus.el b/lisp/gnus.el index 9279231..51a6f23 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -302,9 +302,6 @@ be set in `.emacs' instead." (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) @@ -2846,12 +2843,8 @@ gnus-registry.el will populate this if it's loaded.") ;; 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. diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index c546316..eec283b 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -88,14 +88,14 @@ backslash and doublequote.") (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))) diff --git a/lisp/imap.el b/lisp/imap.el index b6f0fee..a8cc8aa 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -145,22 +145,17 @@ (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. @@ -919,11 +914,16 @@ Returns t if login was successful, nil otherwise." (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) @@ -2440,7 +2440,7 @@ Return nil if no complete line has arrived." ;; 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) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 7bf272c..87f5a27 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -29,12 +29,11 @@ (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' @@ -909,7 +908,7 @@ This only works when `display-time' is enabled." (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)) diff --git a/lisp/message.el b/lisp/message.el index 66c7340..b4bd3bb 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1744,8 +1744,6 @@ no, only reply back to the author." (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") @@ -3942,7 +3940,7 @@ used to distinguish whether the invisible text is a MIME part or not." 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"))))) @@ -5655,7 +5653,7 @@ Headers already prepared in the buffer are not modified." (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 @@ -5889,7 +5887,7 @@ beginning of line." (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) diff --git a/lisp/messagexmas.el b/lisp/messagexmas.el index d94afa8..7bbac9f 100644 --- a/lisp/messagexmas.el +++ b/lisp/messagexmas.el @@ -122,9 +122,8 @@ If it is non-nil, it must be a toolbar. The five valid values are '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)) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 0fcc1be..550c480 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -837,16 +837,16 @@ external if displayed external." (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) ""))) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 5c1ea1e..16cb2d7 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -25,9 +25,9 @@ ;;; 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) @@ -47,9 +47,6 @@ (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." @@ -675,21 +672,6 @@ Equivalent to `progn' in XEmacs" 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) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 27a873f..4328ce7 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -566,8 +566,6 @@ this keymap, add them to `w3m-minor-mode-map' instead of this keymap."))) (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)) @@ -578,7 +576,7 @@ this keymap, add them to `w3m-minor-mode-map' instead of this keymap."))) (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) ") ") "")) diff --git a/lisp/mml.el b/lisp/mml.el index cdec507..a7ee8de 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -34,7 +34,6 @@ (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") @@ -892,7 +891,7 @@ See Info node `(emacs-mime)Composing'. (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))) @@ -940,10 +939,11 @@ See Info node `(emacs-mime)Composing'. (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))) diff --git a/lisp/mml2015.el b/lisp/mml2015.el index 6bf4f4e..166d49c 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -29,7 +29,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'mm-decode) (require 'mm-util) (require 'mml) diff --git a/lisp/netrc.el b/lisp/netrc.el index 3bfc76d..b561885 100644 --- a/lisp/netrc.el +++ b/lisp/netrc.el @@ -31,16 +31,67 @@ ;;; 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 @@ -48,11 +99,33 @@ "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 ") diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index 0dd568d..400cb85 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -71,9 +71,6 @@ (defvoo nnbabyl-previous-buffer-mode nil) -(eval-and-compile - (autoload 'gnus-set-text-properties "gnus-ems")) - ;;; Interface functions @@ -272,7 +269,7 @@ (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) diff --git a/lisp/nndiary.el b/lisp/nndiary.el index 51cbd9a..28cf37e 100644 --- a/lisp/nndiary.el +++ b/lisp/nndiary.el @@ -992,7 +992,7 @@ all. This may very well take some time.") (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) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 643eb39..fae2f28 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -31,7 +31,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'nnheader) (require 'message) @@ -204,7 +203,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (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 @@ -214,7 +213,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (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. @@ -288,7 +287,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (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) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 0928e90..ddd87ad 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -136,7 +136,6 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") (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. @@ -328,7 +327,7 @@ nil, ." (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)) @@ -404,18 +403,18 @@ nil, ." (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) @@ -664,9 +663,9 @@ given, the return value will not contain the last newline." (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))) @@ -775,7 +774,7 @@ given, the return value will not contain the last newline." (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 @@ -1178,7 +1177,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; 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 @@ -1604,7 +1603,6 @@ find-file-hooks, etc. "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) diff --git a/lisp/nnheaderxm.el b/lisp/nnheaderxm.el index af0979c..d9021e7 100644 --- a/lisp/nnheaderxm.el +++ b/lisp/nnheaderxm.el @@ -28,67 +28,11 @@ ;;; 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\"." @@ -110,10 +54,6 @@ or `cancel-timer'." (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) diff --git a/lisp/nnimap.el b/lisp/nnimap.el index f23a001..4c5d718 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -61,7 +61,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'imap) (require 'nnoo) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index 4c67880..d522c55 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -32,7 +32,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'nntp) (require 'nnheader) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index d632ba7..03cdc17 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -670,7 +670,7 @@ nn*-request-list should have been called before calling this function." (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))) @@ -1108,7 +1108,7 @@ FUNC will be called with the group name to determine the article number." (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)) @@ -1617,7 +1617,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (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. diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 18ab15a..ba31475 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -34,7 +34,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'nnheader) (require 'nnmail) diff --git a/lisp/nnml.el b/lisp/nnml.el index ba778e2..7fb52c9 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -33,7 +33,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'nnheader) @@ -574,7 +573,7 @@ marks file will be regenerated properly by Gnus.") (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) @@ -701,7 +700,7 @@ marks file will be regenerated properly by Gnus.") (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." diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el deleted file mode 100644 index 3a7a853..0000000 --- a/lisp/nnshimbun.el +++ /dev/null @@ -1,758 +0,0 @@ -;;; nnshimbun.el --- interfacing with web newspapers - -;; Copyright (C) 2000,2001,2002 TSUCHIYA Masatoshi - -;; Authors: TSUCHIYA Masatoshi , -;; Akihiro Arisawa , -;; Katsumi Yamaoka , -;; Yuuichi Teranishi -;; 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 diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index 57de225..614de21 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -26,7 +26,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'nnoo) (require 'message) diff --git a/lisp/nnspool.el b/lisp/nnspool.el index add0e7e..67b6f0d 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -30,7 +30,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'nnheader) (require 'nntp) diff --git a/lisp/nntp.el b/lisp/nntp.el index a3f1e18..3a8dd7c 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -28,7 +28,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'nnheader) (require 'nnoo) @@ -475,7 +474,7 @@ be restored and the command retried." (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)))) @@ -499,7 +498,7 @@ be restored and the command retried." (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)))) @@ -528,7 +527,7 @@ be restored and the command retried." (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)))) @@ -607,7 +606,7 @@ command whose response triggered the error." (let ((timer (and nntp-connection-timeout - (nnheader-run-at-time + (run-at-time nntp-connection-timeout nil '(lambda () (let ((process (nntp-find-connection @@ -1130,7 +1129,7 @@ password contained in '~/.nntp-authinfo'." (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. @@ -1167,7 +1166,7 @@ password contained in '~/.nntp-authinfo'." (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))))) @@ -1276,7 +1275,7 @@ password contained in '~/.nntp-authinfo'." ;; 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 () diff --git a/lisp/nnultimate.el b/lisp/nnultimate.el index 9730922..bab703b 100644 --- a/lisp/nnultimate.el +++ b/lisp/nnultimate.el @@ -30,7 +30,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'nnoo) (require 'message) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 76a4670..b008931 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -401,7 +401,7 @@ component group will show up when you enter the virtual group.") (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. @@ -417,8 +417,8 @@ component group will show up when you enter the virtual group.") ;; 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)) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index d71f595..f8cbdd7 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -29,7 +29,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'nnoo) (require 'message) diff --git a/lisp/nnwfm.el b/lisp/nnwfm.el index 17f2656..7731e59 100644 --- a/lisp/nnwfm.el +++ b/lisp/nnwfm.el @@ -29,7 +29,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'nnoo) (require 'message) diff --git a/lisp/password.el b/lisp/password.el index b0d96a4..a60e39e 100644 --- a/lisp/password.el +++ b/lisp/password.el @@ -52,7 +52,9 @@ ;;; Code: -(autoload 'run-at-time "timer") +(if (featurep 'xemacs) + (require 'run-at-time) + (autoload 'run-at-time "timer")) (eval-when-compile (require 'cl)) @@ -82,84 +84,6 @@ The variable `password-cache' control whether the cache is used." (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', @@ -178,9 +102,9 @@ The password is removed by a timer after `password-cache-expiry' 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) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 3453f7b..17493af 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -29,24 +29,7 @@ (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) @@ -55,18 +38,6 @@ Value is what BODY returns." (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) @@ -134,7 +105,7 @@ quoted-printable and base64 respectively.") (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))) @@ -424,7 +395,7 @@ By default, the region is treated as containing addresses (see (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 @@ -483,7 +454,7 @@ By default, the region is treated as containing addresses (see (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)) @@ -554,18 +525,18 @@ By default, the region is treated as containing addresses (see (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) @@ -585,7 +556,7 @@ By default, the region is treated as containing addresses (see (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. diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index bd88c71..7f3a014 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -25,9 +25,6 @@ ;;; 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") diff --git a/lisp/run-at-time.el b/lisp/run-at-time.el new file mode 100644 index 0000000..25c3efd --- /dev/null +++ b/lisp/run-at-time.el @@ -0,0 +1,101 @@ +;;; 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 + +;; 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 diff --git a/lisp/smime.el b/lisp/smime.el index 908e696..77919c8 100644 --- a/lisp/smime.el +++ b/lisp/smime.el @@ -512,20 +512,13 @@ A string or a list of strings is returned." (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)) diff --git a/lisp/spam-stat.el b/lisp/spam-stat.el index e85e057..bbbba63 100644 --- a/lisp/spam-stat.el +++ b/lisp/spam-stat.el @@ -193,36 +193,6 @@ This is set by hooking into Gnus.") (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 () diff --git a/lisp/spam.el b/lisp/spam.el index 008f8e9..235409b 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -760,11 +760,6 @@ spam-use-* variable.") (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) @@ -1365,7 +1360,7 @@ functions") ;; 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) @@ -1553,7 +1548,7 @@ REMOVE not nil, remove the ADDRESSES." (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)) diff --git a/make.bat b/make.bat index ddd22a3..e091bd9 100755 --- a/make.bat +++ b/make.bat @@ -192,7 +192,7 @@ echo * echo * (add-to-list 'load-path "/Path/to/gnus/lisp") echo * (if (featurep 'xemacs) echo * (add-to-list 'Info-directory-list "c:/Path/to/gnus/texi/") -echo * (add-to-list 'Info-default-directory-list "c:/Path/to/gnus/texi/") +echo * (add-to-list 'Info-default-directory-list "c:/Path/to/gnus/texi/")) echo * (require 'gnus-load) echo * echo * Replace c:/Path/to/gnus with the Path where your new Gnus is (that's here