summaryrefslogtreecommitdiff
path: root/lisp/obsolete
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/obsolete')
-rw-r--r--lisp/obsolete/cc-compat.el4
-rw-r--r--lisp/obsolete/cl-compat.el1
-rw-r--r--lisp/obsolete/cl.el20
-rw-r--r--lisp/obsolete/complete.el4
-rw-r--r--lisp/obsolete/crisp.el22
-rw-r--r--lisp/obsolete/cust-print.el10
-rw-r--r--lisp/obsolete/erc-compat.el163
-rw-r--r--lisp/obsolete/eudcb-ph.el4
-rw-r--r--lisp/obsolete/fast-lock.el35
-rw-r--r--lisp/obsolete/iswitchb.el16
-rw-r--r--lisp/obsolete/landmark.el14
-rw-r--r--lisp/obsolete/longlines.el4
-rw-r--r--lisp/obsolete/nnir.el14
-rw-r--r--lisp/obsolete/otodo-mode.el3
-rw-r--r--lisp/obsolete/pgg-parse.el3
-rw-r--r--lisp/obsolete/pgg.el3
-rw-r--r--lisp/obsolete/rcompile.el8
-rw-r--r--lisp/obsolete/rfc2368.el136
-rw-r--r--lisp/obsolete/terminal.el9
-rw-r--r--lisp/obsolete/tls.el4
-rw-r--r--lisp/obsolete/tpu-edt.el29
-rw-r--r--lisp/obsolete/tpu-mapper.el54
-rw-r--r--lisp/obsolete/url-ns.el2
-rw-r--r--lisp/obsolete/vc-arch.el2
-rw-r--r--lisp/obsolete/vip.el14
25 files changed, 230 insertions, 348 deletions
diff --git a/lisp/obsolete/cc-compat.el b/lisp/obsolete/cc-compat.el
index 037a8e9e87c..2c383d31c84 100644
--- a/lisp/obsolete/cc-compat.el
+++ b/lisp/obsolete/cc-compat.el
@@ -80,7 +80,7 @@ This is in addition to c-continued-statement-offset.")
;; these offsets are taken by brute force testing c-mode.el, since
;; there's no logic to what it does.
-(let* ((offsets '(c-offsets-alist .
+(let* ((offsets '((c-offsets-alist .
((defun-block-intro . cc-block-intro-offset)
(statement-block-intro . cc-block-intro-offset)
(defun-open . 0)
@@ -95,7 +95,7 @@ This is in addition to c-continued-statement-offset.")
(case-label . c-label-offset)
(access-label . c-label-offset)
(label . c-label-offset)
- ))))
+ )))))
(c-add-style "BOCM" offsets))
diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el
index 619bc06122b..0dba366192e 100644
--- a/lisp/obsolete/cl-compat.el
+++ b/lisp/obsolete/cl-compat.el
@@ -52,6 +52,7 @@
;;; Keyword routines not supported by new package.
(defmacro defkeyword (x &optional doc)
+ (declare (indent defun))
(cl-list* 'defconst x (list 'quote x) (and doc (list doc))))
(defun keyword-of (sym)
diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el
index 09f9ab7b7f2..a892ed7c76b 100644
--- a/lisp/obsolete/cl.el
+++ b/lisp/obsolete/cl.el
@@ -431,8 +431,7 @@ definitions, or lack thereof).
(obsolete "use either `cl-flet' or `cl-letf'." "24.3"))
`(letf ,(mapcar
(lambda (x)
- (if (or (and (fboundp (car x))
- (eq (car-safe (symbol-function (car x))) 'macro))
+ (if (or (eq (car-safe (symbol-function (car x))) 'macro)
(cdr (assq (car x) macroexpand-all-environment)))
(error "Use `labels', not `flet', to rebind macro names"))
(let ((func `(cl-function
@@ -466,10 +465,10 @@ rather than relying on `lexical-binding'."
(push `(cl-function (lambda . ,(cdr binding))) sets)
(push var sets)
(push (cons (car binding)
- `(lambda (&rest cl-labels-args)
- (if (eq (car cl-labels-args) cl--labels-magic)
- (list cl--labels-magic ',var)
- (cl-list* 'funcall ',var cl-labels-args))))
+ (lambda (&rest cl-labels-args)
+ (if (eq (car cl-labels-args) cl--labels-magic)
+ (list cl--labels-magic var)
+ (cl-list* 'funcall var cl-labels-args))))
newenv)))
;; `lexical-let' adds `cl--function-convert' (which calls
;; `cl--labels-convert') as a macroexpander for `function'.
@@ -514,7 +513,8 @@ a temporary-variables list, a value-forms list, a store-variables list
See `gv-define-expander', and `gv-define-setter' for better and
simpler ways to define setf-methods."
(declare (debug
- (&define name cl-lambda-list cl-declarations-or-string def-body)))
+ (&define name cl-lambda-list cl-declarations-or-string def-body))
+ (indent defun))
`(progn
,@(if (stringp (car body))
(list `(put ',name 'setf-documentation ,(pop body))))
@@ -555,7 +555,8 @@ You can replace this form with `gv-define-setter'.
(&define name
[&or [symbolp &optional stringp]
[cl-lambda-list (symbolp)]]
- cl-declarations-or-string def-body)))
+ cl-declarations-or-string def-body))
+ (indent defun))
(if (and (listp arg1) (consp args))
;; Like `gv-define-setter' but with `cl-function'.
`(gv-define-expander ,name
@@ -616,7 +617,8 @@ arguments from ARGLIST using FUNC. For example:
You can replace this macro with `gv-letplace'."
(declare (debug
(&define name cl-lambda-list ;; should exclude &key
- symbolp &optional stringp)))
+ symbolp &optional stringp))
+ (indent defun))
(if (memq '&key arglist)
(error "&key not allowed in define-modify-macro"))
(require 'cl-macs) ;For cl--arglist-args.
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index 1c1167db89b..2d3be2dd9a4 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -243,7 +243,7 @@ second TAB brings up the `*Completions*' buffer."
(when (and partial-completion-mode (null PC-env-vars-alist))
(setq PC-env-vars-alist
(mapcar (lambda (string)
- (let ((d (string-match "=" string)))
+ (let ((d (string-search "=" string)))
(cons (concat "$" (substring string 0 d))
(and d (substring string (1+ d))))))
process-environment))))
@@ -575,7 +575,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
p (+ p (length PC-ndelims-regex) 1)))))
(setq p 0)
(if filename
- (while (setq p (string-match "\\\\\\*" regex p))
+ (while (setq p (string-search "\\*" regex p))
(setq regex (concat (substring regex 0 p)
"[^/]*"
(substring regex (+ p 2))))))
diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el
index 69bf3ed12bc..ccf9aaa2b6a 100644
--- a/lisp/obsolete/crisp.el
+++ b/lisp/obsolete/crisp.el
@@ -231,27 +231,13 @@ does not load the scroll-all package."
;; The cut and paste routines are different between XEmacs and Emacs
;; so we need to set up aliases for the functions.
-
-(defalias 'crisp-set-clipboard
- (if (fboundp 'clipboard-kill-ring-save)
- 'clipboard-kill-ring-save
- 'copy-primary-selection))
-
-(defalias 'crisp-kill-region
- (if (fboundp 'clipboard-kill-region)
- 'clipboard-kill-region
- 'kill-primary-selection))
-
-(defalias 'crisp-yank-clipboard
- (if (fboundp 'clipboard-yank)
- 'clipboard-yank
- 'yank-clipboard-selection))
+(defalias 'crisp-set-clipboard 'clipboard-kill-ring-save)
+(defalias 'crisp-kill-region 'clipboard-kill-region)
+(defalias 'crisp-yank-clipboard 'clipboard-yank)
(defun crisp-region-active ()
"Compatibility function to test for an active region."
- (if (featurep 'xemacs)
- zmacs-region-active-p
- mark-active))
+ mark-active)
(defun crisp-version (&optional arg)
"Version number of the CRiSP emulator package.
diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el
index 01fcd38199c..897b4015889 100644
--- a/lisp/obsolete/cust-print.el
+++ b/lisp/obsolete/cust-print.el
@@ -643,11 +643,11 @@ See `custom-format' for the details."
(let ((print-circle t))
(or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)")
- (error "circular object with array printing")))
+ (error "Circular object with array printing")))
(let ((print-circle t))
(or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)")
- (error "circular object with array printing")))
+ (error "Circular object with array printing")))
(let* ((print-circle t)
(x (list 'p 'q))
@@ -655,16 +655,16 @@ See `custom-format' for the details."
(setcdr (cdr (cdr (cdr y))) (cdr y))
(or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))"
)
- (error "circular list example from CL manual")))
+ (error "Circular list example from CL manual")))
(let ((print-circle nil))
;; cl-packages.el is required to print uninterned symbols like #:FOO.
;; (require 'cl-packages)
(or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)")
- (error "uninterned symbols in list")))
+ (error "Uninterned symbols in list")))
(let ((print-circle t))
(or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)")
- (error "circular uninterned symbols in list")))
+ (error "Circular uninterned symbols in list")))
(uninstall-custom-print)
)
diff --git a/lisp/obsolete/erc-compat.el b/lisp/obsolete/erc-compat.el
deleted file mode 100644
index 9972e927e61..00000000000
--- a/lisp/obsolete/erc-compat.el
+++ /dev/null
@@ -1,163 +0,0 @@
-;;; erc-compat.el --- ERC compatibility code for XEmacs -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
-
-;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; URL: https://www.emacswiki.org/emacs/ERC
-;; Obsolete-since: 28.1
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This mostly defines stuff that cannot be worked around easily.
-
-;;; Code:
-
-(require 'format-spec)
-
-;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
-(defalias 'erc-define-minor-mode #'define-minor-mode)
-
-(defun erc-decode-coding-string (s coding-system)
- "Decode S using CODING-SYSTEM."
- (decode-coding-string s coding-system t))
-
-(defun erc-encode-coding-string (s coding-system)
- "Encode S using CODING-SYSTEM.
-Return the same string, if the encoding operation is trivial.
-See `erc-encoding-coding-alist'."
- (encode-coding-string s coding-system t))
-
-(define-obsolete-function-alias 'erc-propertize #'propertize "28.1")
-(define-obsolete-function-alias 'erc-view-mode-enter #'view-mode-enter "28.1")
-(autoload 'help-function-arglist "help-fns")
-(define-obsolete-function-alias 'erc-function-arglist #'help-function-arglist "28.1")
-(define-obsolete-function-alias 'erc-delete-dups #'delete-dups "28.1")
-(define-obsolete-function-alias 'erc-replace-regexp-in-string #'replace-regexp-in-string "28.1")
-
-(defun erc-set-write-file-functions (new-val)
- (set (make-local-variable 'write-file-functions) new-val))
-
-(defvar erc-emacs-build-time
- (if (or (stringp emacs-build-time) (not emacs-build-time))
- emacs-build-time
- (format-time-string "%Y-%m-%d" emacs-build-time))
- "Time at which Emacs was dumped out, or nil if not available.")
-
-;; Emacs 21 and XEmacs do not have user-emacs-directory, but XEmacs
-;; has user-init-directory.
-(defvar erc-user-emacs-directory
- (cond ((boundp 'user-emacs-directory)
- user-emacs-directory)
- ((boundp 'user-init-directory)
- user-init-directory)
- (t "~/.emacs.d/"))
- "Directory beneath which additional per-user Emacs-specific files
-are placed.
-Note that this should end with a directory separator.")
-
-(defun erc-replace-match-subexpression-in-string
- (newtext string _match subexp _start &optional fixedcase literal)
- "Replace the subexpression SUBEXP of the last match in STRING with NEWTEXT.
-MATCH is the text which matched the subexpression (see `match-string').
-START is the beginning position of the last match (see `match-beginning').
-See `replace-match' for explanations of FIXEDCASE and LITERAL."
- (replace-match newtext fixedcase literal string subexp))
-
-(define-obsolete-function-alias 'erc-with-selected-window
- #'with-selected-window "28.1")
-(define-obsolete-function-alias 'erc-cancel-timer #'cancel-timer "28.1")
-(define-obsolete-function-alias 'erc-make-obsolete #'make-obsolete "28.1")
-(define-obsolete-function-alias 'erc-make-obsolete-variable
- #'make-obsolete-variable "28.1")
-
-;; Provide a simpler replacement for `member-if'
-(defun erc-member-if (predicate list)
- "Find the first item satisfying PREDICATE in LIST.
-Return the sublist of LIST whose car matches."
- (let ((ptr list))
- (catch 'found
- (while ptr
- (when (funcall predicate (car ptr))
- (throw 'found ptr))
- (setq ptr (cdr ptr))))))
-
-;; Provide a simpler replacement for `delete-if'
-(defun erc-delete-if (predicate seq)
- "Remove all items satisfying PREDICATE in SEQ.
-This is a destructive function: it reuses the storage of SEQ
-whenever possible."
- ;; remove from car
- (while (when (funcall predicate (car seq))
- (setq seq (cdr seq))))
- ;; remove from cdr
- (let ((ptr seq)
- (next (cdr seq)))
- (while next
- (when (funcall predicate (car next))
- (setcdr ptr (if (consp next)
- (cdr next)
- nil)))
- (setq ptr (cdr ptr))
- (setq next (cdr ptr))))
- seq)
-
-;; Provide a simpler replacement for `remove-if-not'
-(defun erc-remove-if-not (predicate seq)
- "Remove all items not satisfying PREDICATE in SEQ.
-This is a non-destructive function; it makes a copy of SEQ to
-avoid corrupting the original SEQ."
- (let (newseq)
- (dolist (el seq)
- (when (funcall predicate el)
- (setq newseq (cons el newseq))))
- (nreverse newseq)))
-
-;; Copied from cl-extra.el
-(defun erc-subseq (seq start &optional end)
- "Return the subsequence of SEQ from START to END.
-If END is omitted, it defaults to the length of the sequence.
-If START or END is negative, it counts from the end."
- (if (stringp seq) (substring seq start end)
- (let (len)
- (and end (< 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)))
- (if end
- (let ((res nil))
- (while (>= (setq end (1- end)) start)
- (push (pop seq) res))
- (nreverse res))
- (copy-sequence seq)))
- (t
- (or end (setq end (or len (length seq))))
- (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))))))
-
-(provide 'erc-compat)
-
-;;; erc-compat.el ends here
-;;
-;; Local Variables:
-;; generated-autoload-file: "erc-loaddefs.el"
-;; End:
diff --git a/lisp/obsolete/eudcb-ph.el b/lisp/obsolete/eudcb-ph.el
index 187879ce2f7..51a6780d903 100644
--- a/lisp/obsolete/eudcb-ph.el
+++ b/lisp/obsolete/eudcb-ph.el
@@ -176,9 +176,7 @@ SERVER is either a string naming the server or a list (NAME PORT)."
(setq eudc-ph-process-buffer (get-buffer-create (format " *PH-%s*" host)))
(with-current-buffer eudc-ph-process-buffer
(erase-buffer)
- (setq eudc-ph-read-point (point))
- (and (featurep 'xemacs) (featurep 'mule)
- (set-buffer-file-coding-system 'binary t)))
+ (setq eudc-ph-read-point (point)))
(setq process (open-network-stream "ph" eudc-ph-process-buffer host port))
(if (null process)
(throw 'done nil))
diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el
index 960233d5627..1dee7120c0e 100644
--- a/lisp/obsolete/fast-lock.el
+++ b/lisp/obsolete/fast-lock.el
@@ -283,10 +283,7 @@ If a number, only buffers greater than this size have processing messages."
(other :tag "always" t)
(integer :tag "size")))
-(defvar fast-lock-save-faces
- (when (featurep 'xemacs)
- ;; XEmacs uses extents for everything, so we have to pick the right ones.
- font-lock-face-list)
+(defvar fast-lock-save-faces nil
"Faces that will be saved in a Font Lock cache file.
If nil, means information for all faces will be saved.")
@@ -707,35 +704,7 @@ See `fast-lock-get-face-properties'."
(while regions
(add-text-properties (nth 0 regions) (nth 1 regions) plist)
(setq regions (nthcdr 2 regions))))))))
-
-;; Functions for XEmacs:
-
-(unless (boundp 'font-lock-syntactic-keywords)
- (defvar font-lock-syntactic-keywords nil))
-
-(unless (boundp 'font-lock-inhibit-thing-lock)
- (defvar font-lock-inhibit-thing-lock nil))
-
-(unless (fboundp 'font-lock-compile-keywords)
- (defalias 'font-lock-compile-keywords #'identity))
-
-(unless (fboundp 'font-lock-eval-keywords)
- (defun font-lock-eval-keywords (keywords)
- (if (symbolp keywords)
- (font-lock-eval-keywords (if (fboundp keywords)
- (funcall keywords)
- (eval keywords t)))
- keywords)))
-
-(unless (fboundp 'font-lock-value-in-major-mode)
- (defun font-lock-value-in-major-mode (alist)
- (if (consp alist)
- (cdr (or (assq major-mode alist) (assq t alist)))
- alist)))
-
-(unless (fboundp 'current-message)
- (defun current-message ()
- ""))
+
;; Install ourselves:
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index a630baf3543..807f5485d5f 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -977,17 +977,7 @@ Return the modified list with the last element prepended to it."
(set-buffer buf))
(with-output-to-temp-buffer temp-buf
- (if (featurep 'xemacs)
-
- ;; XEmacs extents are put on by default, doesn't seem to be
- ;; any way of switching them off.
- (display-completion-list (or iswitchb-matches iswitchb-buflist)
- :help-string "iswitchb "
- :activate-callback
- (lambda (_x _y _z)
- (message "doesn't work yet, sorry!")))
- ;; else running Emacs
- (display-completion-list (or iswitchb-matches iswitchb-buflist))))
+ (display-completion-list (or iswitchb-matches iswitchb-buflist)))
(setq iswitchb-common-match-inserted nil))))
;;; KILL CURRENT BUFFER
@@ -1326,9 +1316,7 @@ This is an example function which can be hooked on to
"Return non-nil if we should ignore case when matching.
See the variable `iswitchb-case' for details."
(if iswitchb-case
- (if (featurep 'xemacs)
- (isearch-no-upper-case-p iswitchb-text)
- (isearch-no-upper-case-p iswitchb-text t))))
+ (isearch-no-upper-case-p iswitchb-text t)))
;;;###autoload
(define-minor-mode iswitchb-mode
diff --git a/lisp/obsolete/landmark.el b/lisp/obsolete/landmark.el
index cc4fd19c389..16c41c76ad2 100644
--- a/lisp/obsolete/landmark.el
+++ b/lisp/obsolete/landmark.el
@@ -757,9 +757,9 @@ If the game is finished, this command requests for another game."
(let ((square (landmark-point-square))
score)
(cond ((null square)
- (error "Your point is not on a square. Retry!"))
+ (error "Your point is not on a square. Retry!"))
((not (zerop (aref landmark-board square)))
- (error "Your point is not on a free square. Retry!"))
+ (error "Your point is not on a free square. Retry!"))
(t
(setq score (aref landmark-score-table square))
(landmark-play-move square 1)
@@ -823,14 +823,14 @@ If the game is finished, this command requests for another game."
(defun landmark-prompt-for-other-game ()
"Ask for another game, and start it."
(if (y-or-n-p "Another game? ")
- (if (y-or-n-p "Retain learned weights ")
+ (if (y-or-n-p "Retain learned weights?")
(landmark 2)
(landmark 1))
(message "Chicken!")))
(defun landmark-offer-a-draw ()
"Offer a draw and return t if Human accepted it."
- (or (y-or-n-p "I offer you a draw. Do you accept it? ")
+ (or (y-or-n-p "I offer you a draw. Do you accept it?")
(not (setq landmark-human-refused-draw t))))
@@ -1470,7 +1470,7 @@ push him out of it."
(mapc
(lambda (direction) (put direction 'y_t 0))
landmark-directions)
- (dolist (direction (nth (random 8) landmark-8-directions))
+ (dolist (direction (seq-random-elt landmark-8-directions))
(put direction 'y_t 1.0))
(landmark-move))
@@ -1512,9 +1512,9 @@ If the game is finished, this command requests for another game."
(t
(let ((square (landmark-point-square)))
(cond ((null square)
- (error "Your point is not on a square. Retry!"))
+ (error "Your point is not on a square. Retry!"))
((not (zerop (aref landmark-board square)))
- (error "Your point is not on a free square. Retry!"))
+ (error "Your point is not on a free square. Retry!"))
(t
(progn
(landmark-plot-square square 1)
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index 9676d6b28e9..9bf68456826 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -393,11 +393,11 @@ compatibility with `format-alist', and is ignored."
"Return a copy of STRING with each soft newline replaced by a space.
Hard newlines are left intact."
(let* ((str (copy-sequence string))
- (pos (string-match "\n" str)))
+ (pos (string-search "\n" str)))
(while pos
(if (null (get-text-property pos 'hard str))
(aset str pos ? ))
- (setq pos (string-match "\n" str (1+ pos))))
+ (setq pos (string-search "\n" str (1+ pos))))
str))
;;; Auto wrap
diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el
index 40a8ec57b98..9aab1e7c9f5 100644
--- a/lisp/obsolete/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -509,7 +509,7 @@ construct the vector entries."
(vector (gnus-group-full-name group server)
(if (string-match "\\`nnmaildir:" (gnus-group-server server))
(nnmaildir-base-name-to-article-number
- (substring article 0 (string-match ":" article))
+ (substring article 0 (string-search ":" article))
group nil)
(string-to-number article))
(string-to-number score)))))
@@ -920,10 +920,10 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
;; eliminate all ".", "/", "\" from beginning. Always matches.
(string-match "^[./\\]*\\(.*\\)$" dirnam)
;; "/" -> "."
- (setq group (replace-regexp-in-string
+ (setq group (string-replace
"/" "." (match-string 1 dirnam)))
;; Windows "\\" -> "."
- (setq group (replace-regexp-in-string "\\\\" "." group))
+ (setq group (string-replace "\\" "." group))
(push (vector (gnus-group-full-name group server)
(string-to-number artno)
@@ -996,7 +996,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
(when (string-match prefix dirnam)
(setq dirnam (replace-match "" t t dirnam)))
(push (vector (gnus-group-full-name
- (replace-regexp-in-string "/" "." dirnam) server)
+ (string-replace "/" "." dirnam) server)
(string-to-number artno)
(string-to-number score))
artlist))
@@ -1205,9 +1205,9 @@ construct path: search terms (see the variable
group
(if (file-directory-p
(setq group
- (replace-regexp-in-string
- "\\." "/"
- group nil t)))
+ (string-replace
+ "." "/"
+ group)))
group))))))
(unless group
(error "Cannot locate directory for group"))
diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el
index 47f5089452f..a71d2b82e4c 100644
--- a/lisp/obsolete/otodo-mode.el
+++ b/lisp/obsolete/otodo-mode.el
@@ -908,8 +908,7 @@ If INCLUDE-SEP is non-nil, return point after the separator."
;;;###autoload
(define-derived-mode todo-mode nil "TODO"
"Major mode for editing TODO lists."
- (when (featurep 'xemacs)
- (easy-menu-add todo-menu)))
+ nil)
(with-suppressed-warnings ((lexical date entry))
(defvar date)
diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el
index 2c76365a415..3e4c216abef 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -496,8 +496,7 @@
(defun pgg-parse-armor (string)
(with-temp-buffer
(buffer-disable-undo)
- (unless (featurep 'xemacs)
- (set-buffer-multibyte nil))
+ (set-buffer-multibyte nil)
(insert string)
(pgg-decode-armor-region (point-min)(point))))
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el
index 5ed59933f23..127e1dc15c0 100644
--- a/lisp/obsolete/pgg.el
+++ b/lisp/obsolete/pgg.el
@@ -376,8 +376,7 @@ signer's public key from `pgg-default-keyserver-address'."
(if (null signature) nil
(with-temp-buffer
(buffer-disable-undo)
- (unless (featurep 'xemacs)
- (set-buffer-multibyte nil))
+ (set-buffer-multibyte nil)
(insert-file-contents signature)
(cdr (assq 2 (pgg-decode-armor-region
(point-min)(point-max)))))))
diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el
index d7020f0d074..c8fb9f20985 100644
--- a/lisp/obsolete/rcompile.el
+++ b/lisp/obsolete/rcompile.el
@@ -108,7 +108,10 @@ nil means run no commands."
;;;; entry point
-;; We use the Tramp internal function`tramp-make-tramp-file-name'.
+;; We use the Tramp internal function `tramp-make-tramp-file-name'.
+;; It has changed its signature in Emacs 27.1, supporting still the
+;; old calling convention. Let's assume rcompile.el has been removed
+;; once Tramp does not support it any longer.
;; Better would be, if there are functions to provide user, host and
;; localname of a remote filename, independent of Tramp's implementation.
;; The function calls are wrapped by `funcall' in order to pacify the byte
@@ -167,7 +170,8 @@ See \\[compile]."
(with-current-buffer compilation-last-buffer
(when (fboundp 'tramp-make-tramp-file-name)
(set (make-local-variable 'comint-file-name-prefix)
- (tramp-make-tramp-file-name
+ (funcall
+ #'tramp-make-tramp-file-name
nil ;; method.
remote-compile-user
remote-compile-host
diff --git a/lisp/obsolete/rfc2368.el b/lisp/obsolete/rfc2368.el
new file mode 100644
index 00000000000..8a842b0cf30
--- /dev/null
+++ b/lisp/obsolete/rfc2368.el
@@ -0,0 +1,136 @@
+;;; rfc2368.el --- support for rfc2368 -*- lexical-binding:t -*-
+
+;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
+
+;; Author: Sen Nagata <sen@eccosys.com>
+;; Keywords: mail
+;; Obsolete-since: 28.1
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; notes:
+;;
+;; -repeat after me: "the colon is not part of the header name..."
+;; -if w3 becomes part of emacs, then it may make sense to have this
+;; file depend on w3 -- the maintainer of w3 says merging w/ Emacs
+;; is planned!
+;;
+;; historical note:
+;;
+;; this is intended as a replacement for mailto.el
+;;
+;; acknowledgments:
+;;
+;; the functions that deal w/ unhexifying in this file were basically
+;; taken from w3 -- i hope to replace them w/ something else soon OR
+;; perhaps if w3 becomes a part of emacs soon, use the functions from w3.
+
+;;; History:
+;;
+;; 0.3:
+;;
+;; added the constant rfc2368-version
+;; implemented first potential fix for a bug in rfc2368-mailto-regexp
+;; implemented first potential fix for a bug in rfc2368-parse-mailto
+;; (both bugs reported by Kenichi OKADA)
+;;
+;; 0.2:
+;;
+;; started to use checkdoc
+;;
+;; 0.1:
+;;
+;; initial implementation
+
+;;; Code:
+
+;; only an approximation?
+;; see rfc 1738
+(defconst rfc2368-mailto-regexp
+ "^\\(mailto:\\)\\([^?]+\\)?\\(\\?\\(.*\\)\\)*"
+ "Regular expression to match and aid in parsing a mailto url.")
+
+;; describes 'mailto:'
+(defconst rfc2368-mailto-scheme-index 1
+ "Describes the `mailto:' portion of the url.")
+;; i'm going to call this part the 'prequery'
+(defconst rfc2368-mailto-prequery-index 2
+ "Describes the portion of the url between `mailto:' and `?'.")
+;; i'm going to call this part the 'query'
+(defconst rfc2368-mailto-query-index 4
+ "Describes the portion of the url after `?'.")
+
+(defun rfc2368-unhexify-string (string)
+ "Unhexify STRING -- e.g. `hello%20there' -> `hello there'."
+ (replace-regexp-in-string "%[[:xdigit:]]\\{2\\}"
+ (lambda (match)
+ (string (string-to-number (substring match 1)
+ 16)))
+ string t t))
+
+(defun rfc2368-parse-mailto-url (mailto-url)
+ "Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
+MAILTO-URL should be a RFC 2368 (mailto) compliant url. A cons cell w/ a
+key of `Body' is a special case and is considered a header for this purpose.
+The returned alist is intended for use w/ the `compose-mail' interface.
+Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., &amp; -> &), before
+calling this function."
+ (let ((case-fold-search t)
+ prequery query headers-alist)
+ (setq mailto-url (string-replace "\n" " " mailto-url))
+ (if (string-match rfc2368-mailto-regexp mailto-url)
+ (progn
+ (setq prequery
+ (match-string rfc2368-mailto-prequery-index mailto-url))
+ (setq query
+ (match-string rfc2368-mailto-query-index mailto-url))
+
+ ;; build alist of header name-value pairs
+ (if (not (null query))
+ (setq headers-alist
+ (mapcar
+ (lambda (x)
+ (let* ((temp-list (split-string x "="))
+ (header-name (car temp-list))
+ (header-value (cadr temp-list)))
+ ;; return ("Header-Name" . "header-value")
+ (cons
+ (capitalize (rfc2368-unhexify-string header-name))
+ (rfc2368-unhexify-string header-value))))
+ (split-string query "&"))))
+
+ ;; deal w/ multiple 'To' recipients
+ (if prequery
+ (progn
+ (setq prequery (rfc2368-unhexify-string prequery))
+ (if (assoc "To" headers-alist)
+ (let* ((our-cons-cell
+ (assoc "To" headers-alist))
+ (our-cdr
+ (cdr our-cons-cell)))
+ (setcdr our-cons-cell (concat prequery ", " our-cdr)))
+ (setq headers-alist
+ (cons (cons "To" prequery) headers-alist)))))
+
+ headers-alist)
+
+ (error "Failed to match a mailto: url"))))
+
+(provide 'rfc2368)
+
+;;; rfc2368.el ends here
diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el
index dbfc79bf913..fa89b586a0a 100644
--- a/lisp/obsolete/terminal.el
+++ b/lisp/obsolete/terminal.el
@@ -112,10 +112,9 @@ performance."
nil
(let ((map (make-sparse-keymap)))
(define-key map [t] #'undefined)
- (let ((s "0"))
- (while (<= (aref s 0) ?9)
- (define-key map s #'digit-argument)
- (aset s 0 (1+ (aref s 0)))))
+ (dotimes (i 10)
+ (let ((s (make-string 1 (+ ?0 i))))
+ (define-key map s #'digit-argument)))
(define-key map "b" #'switch-to-buffer)
(define-key map "o" #'other-window)
(define-key map "e" #'te-set-escape-char)
@@ -1222,7 +1221,7 @@ of the terminal-emulator"
(cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'"
string)
string)
- ((not (string-match "[$]" string))
+ ((not (string-search "$" string))
;; "[\"\\]" are special to sh and the lisp reader in the same way
(prin1-to-string string))
(t
diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el
index 5cba18d7897..ff01008613b 100644
--- a/lisp/obsolete/tls.el
+++ b/lisp/obsolete/tls.el
@@ -260,14 +260,14 @@ Fourth arg PORT is an integer specifying a port to connect to."
NOT trusted." host))
(not (yes-or-no-p
(format-message "\
-The certificate presented by `%s' is NOT trusted. Accept anyway? " host)))))
+The certificate presented by `%s' is NOT trusted. Accept anyway?" host)))))
(and tls-hostmismatch
(save-excursion
(goto-char (point-min))
(re-search-forward tls-hostmismatch nil t))
(not (yes-or-no-p
(format "Host name in certificate doesn't \
-match `%s'. Connect anyway? " host))))))
+match `%s'. Connect anyway?" host))))))
(setq done nil)
(delete-process process))
;; Delete all the informational messages that could confuse
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index 1340618f055..b59fb8c868c 100644
--- a/lisp/obsolete/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -650,12 +650,8 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
(setq tpu-mark-flag (if transient-mark-mode "" (if (tpu-mark) " @" " ")))
(force-mode-line-update))
-(cond ((featurep 'xemacs)
- (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line)
- (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line))
- (t
- (add-hook 'activate-mark-hook 'tpu-update-mode-line)
- (add-hook 'deactivate-mark-hook 'tpu-update-mode-line)))
+(add-hook 'activate-mark-hook 'tpu-update-mode-line)
+(add-hook 'deactivate-mark-hook 'tpu-update-mode-line)
;;;
@@ -727,15 +723,13 @@ Otherwise sets the tpu-match markers to nil and returns nil."
"TPU-edt version of the mark function.
Return the appropriate value of the mark for the current
version of Emacs."
- (cond ((featurep 'xemacs) (mark (not zmacs-regions)))
- (t (and mark-active (mark (not transient-mark-mode))))))
+ (and mark-active (mark (not transient-mark-mode))))
(defun tpu-set-mark (pos)
"TPU-edt version of the `set-mark' function.
Sets the mark at POS and activates the region according to the
current version of Emacs."
- (set-mark pos)
- (when (featurep 'xemacs) (when pos (zmacs-activate-region))))
+ (set-mark pos))
(defun tpu-string-prompt (prompt history-symbol)
"Read a string with PROMPT."
@@ -1415,9 +1409,9 @@ If an argument is specified, don't set the search direction."
;; if using regexp, eliminate upper case forms (\B \W \S.)
(if tpu-regexp-p
(let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0))
- (while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\\\" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\B" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\W" pat)) (aset pat (+ 1 pos) ?.))
(while (setq pos (string-match "\\\\S." pat))
(aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.))
(string-equal pat (downcase pat)))
@@ -2306,17 +2300,14 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll."
;;;
(defun tpu-load-xkeys (file)
"Load the TPU-edt X-windows key definitions FILE.
-If FILE is nil, try to load a default file. The default file names are
-`~/.tpu-lucid-keys' for XEmacs, and `~/.tpu-keys' for Emacs."
+If FILE is nil, try to load a default file. The default file name is
+`~/.tpu-keys'."
(interactive "fX key definition file: ")
(cond (file
(setq file (expand-file-name file)))
(tpu-xkeys-file
(setq file (expand-file-name tpu-xkeys-file)))
- ((featurep 'xemacs)
- (setq file (convert-standard-filename
- (expand-file-name "~/.tpu-lucid-keys"))))
- (t
+ (t
(setq file (convert-standard-filename
(expand-file-name "~/.tpu-keys")))
(and (not (file-exists-p file))
diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el
index 5ae0a6558d5..02ba3632504 100644
--- a/lisp/obsolete/tpu-mapper.el
+++ b/lisp/obsolete/tpu-mapper.el
@@ -46,24 +46,14 @@
;;;
(defun tpu-map-key (ident descrip func gold-func)
(interactive)
- (if (featurep 'xemacs)
- (progn
- (setq tpu-key-seq (read-key-sequence
- (format "Press %s%s: " ident descrip))
- tpu-key (format "[%s]" (event-key (aref tpu-key-seq 0))))
- (unless (equal tpu-key tpu-return)
- (set-buffer "Keys")
- (insert (format"(global-set-key %s %s)\n" tpu-key func))
- (set-buffer "Gold-Keys")
- (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))))
- (message "Press %s%s: " ident descrip)
- (setq tpu-key-seq (read-event)
- tpu-key (format "[%s]" tpu-key-seq))
- (unless (equal tpu-key tpu-return)
- (set-buffer "Keys")
- (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
- (set-buffer "Gold-Keys")
- (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))))
+ (message "Press %s%s: " ident descrip)
+ (setq tpu-key-seq (read-event)
+ tpu-key (format "[%s]" tpu-key-seq))
+ (unless (equal tpu-key tpu-return)
+ (set-buffer "Keys")
+ (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
+ (set-buffer "Gold-Keys")
+ (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func)))
(set-buffer "Directions")
tpu-key)
@@ -103,8 +93,7 @@ your local X guru can try to figure out why the key is being ignored."
;; Make sure the window is big enough to display the instructions
- (if (featurep 'xemacs) (set-screen-size (selected-screen) 80 36)
- (set-frame-size (selected-frame) 80 36))
+ (set-frame-size (selected-frame) 80 36)
;; Create buffers - Directions, Keys, Gold-Keys
@@ -162,14 +151,9 @@ your local X guru can try to figure out why the key is being ignored."
;; Save <CR> for future reference
- (cond
- ((featurep 'xemacs)
- (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
- (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]")))
- (t
- (message "Hit carriage-return <CR> to continue ")
- (setq tpu-return-seq (read-event))
- (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]"))))
+ (message "Hit carriage-return <CR> to continue ")
+ (setq tpu-return-seq (read-event))
+ (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]"))
;; Build the keymap file
@@ -308,24 +292,14 @@ your local X guru can try to figure out why the key is being ignored."
;;
")
- (cond ((featurep 'xemacs)
- (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq))
- (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq))
- (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n")
- (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n")
- (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n")
- (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n"))
- (t
- (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter))))
+ (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter))
(append-to-buffer "Keys" 1 (point))
(set-buffer "Keys")
;; Save the key mapping program
- (let ((file
- (convert-standard-filename
- (if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys"))))
+ (let ((file (convert-standard-filename "~/.tpu-keys")))
(set-visited-file-name
(read-file-name (format "Save key mapping to file (default %s): " file) "" file)))
(save-buffer)
diff --git a/lisp/obsolete/url-ns.el b/lisp/obsolete/url-ns.el
index b62ad829990..6cd6693fc43 100644
--- a/lisp/obsolete/url-ns.el
+++ b/lisp/obsolete/url-ns.el
@@ -31,7 +31,7 @@
;;;###autoload
(defun isPlainHostName (host)
- (not (string-match "\\." host)))
+ (not (string-search "." host)))
;;;###autoload
(defun dnsDomainIs (host dom)
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index cfbf981d3c8..fbbd2d4ecfe 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -24,7 +24,7 @@
;;; Commentary:
-;; The home page of the Arch version control system is at
+;; The Arch version control system website is at
;;
;; https://www.gnu.org/software/gnu-arch/
;;
diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el
index 16906b68a67..2fa8c951531 100644
--- a/lisp/obsolete/vip.el
+++ b/lisp/obsolete/vip.el
@@ -615,11 +615,11 @@ obtained so far, and COM is the command part obtained so far."
(cond ((null arg) nil)
((consp arg) (car arg))
((numberp arg) arg)
- (t (error "strange arg")))
+ (t (error "Strange arg")))
(cond ((null arg) nil)
((consp arg) (cdr arg))
((numberp arg) nil)
- (t (error "strange arg"))))
+ (t (error "Strange arg"))))
(quit
(setq vip-use-register nil)
(signal 'quit nil))))
@@ -2248,7 +2248,7 @@ a token has type \(command, address, end-mark) and value."
(setq ex-token-type "end-mark")
(setq ex-token "goto"))
(t
- (error "invalid token")))))
+ (error "Invalid token")))))
(defun vip-ex (&optional string)
"ex commands within VIP."
@@ -2333,7 +2333,7 @@ a token has type \(command, address, end-mark) and value."
(cond ((looking-at "[a-z]")
(vip-get-ex-com-subr)
(if (string= ex-token-type "non-command")
- (error "%s: not an editor command" ex-token)))
+ (error "%s: Not an editor command" ex-token)))
((looking-at "[!=><&~]")
(setq ex-token (char-to-string (following-char)))
(forward-char 1))
@@ -2378,7 +2378,7 @@ a token has type \(command, address, end-mark) and value."
(progn
(setq ex-flag t)
(setq cont nil))
- (error "address expected")))
+ (error "Address expected")))
((string= ex-token-type "end-mark")
(setq cont nil))
((string= ex-token-type "whole")
@@ -2568,7 +2568,7 @@ a token has type \(command, address, end-mark) and value."
(string= ex-token "insert")
(string= ex-token "open")
)
- (error "%s: no such command from VIP" ex-token))
+ (error "%s: No such command from VIP" ex-token))
((or (string= ex-token "abbreviate")
(string= ex-token "list")
(string= ex-token "next")
@@ -2581,7 +2581,7 @@ a token has type \(command, address, end-mark) and value."
(string= ex-token "xit")
(string= ex-token "z")
)
- (error "%s: not implemented in VIP" ex-token))
+ (error "%s: Not implemented in VIP" ex-token))
(t (error "%s: Not an editor command" ex-token))))
(defun ex-goto ()
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-10 10:43:13 +0000