commit 675787bcd3b666fe5dd19e9eeba6ddd5fc5df0d5 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Fri Feb 12 18:34:15 2016 +1100 Finish up cl-defmethoding registry,el * lisp/gnus/registry.el (initialize-instance): Use cl-defmethod. diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index d89ba48..6684c25 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el @@ -129,7 +129,7 @@ :type hash-table :documentation "The data hashtable."))) -(defmethod initialize-instance :BEFORE ((this registry-db) slots) +(cl-defmethod initialize-instance :before ((this registry-db) slots) "Check whether a registry object needs to be upgraded." ;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the ;; :max-soft slot to disappear, and the :max-hard slot to be renamed @@ -146,7 +146,7 @@ (cl-remf slots :max-hard) (cl-remf slots :max-soft)))) -(defmethod initialize-instance :AFTER ((this registry-db) slots) +(cl-defmethod initialize-instance :after ((this registry-db) slots) "Set value of data slot of THIS after initialization." (with-slots (data tracker) this (unless (member :data slots) commit bd066f82903ac055109882189646d39c2a75e044 Author: Lars Ingebrigtsen Date: Fri Feb 12 18:24:30 2016 +1100 Revert the gnus-replace-in-string change, fix arguments, reapply diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 68d07c7..920544d 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -7521,7 +7521,7 @@ address, `ask' if unsure and `invalid' if the string is invalid." (list gnus-button-mid-or-mail-heuristic-alist) (result 0) rate regexp lpartlen elem) (setq lpartlen - (length (replace-regexp-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1"))) + (length (replace-regexp-in-string "^\\(.*\\)@.*$" "\\1" mid-or-mail))) (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen) ;; Certain special cases... (when (string-match @@ -7592,7 +7592,7 @@ address, `ask' if unsure and `invalid' if the string is invalid." (setq guessed ;; get rid of surrounding angles... (funcall pref - (replace-regexp-in-string mid-or-mail "^<\\|>$" ""))) + (replace-regexp-in-string "^<\\|>$" "" mid-or-mail))) (if (or (eq 'mid guessed) (eq 'mail guessed)) (setq pref guessed) (setq pref 'ask))) @@ -7624,13 +7624,13 @@ as a symbol to FUN." "Call `describe-function' when pushing the corresponding URL button." (describe-function (intern - (replace-regexp-in-string url gnus-button-handle-describe-prefix "")))) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)))) (defun gnus-button-handle-describe-variable (url) "Call `describe-variable' when pushing the corresponding URL button." (describe-variable (intern - (replace-regexp-in-string url gnus-button-handle-describe-prefix "")))) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)))) (defun gnus-button-handle-symbol (url) "Display help on variable or function. @@ -7644,7 +7644,7 @@ Calls `describe-variable' or `describe-function'." (defun gnus-button-handle-describe-key (url) "Call `describe-key' when pushing the corresponding URL button." (let* ((key-string - (replace-regexp-in-string url gnus-button-handle-describe-prefix "")) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)) (keys (ignore-errors (eval `(kbd ,key-string))))) (if keys (describe-key keys) @@ -7652,31 +7652,30 @@ Calls `describe-variable' or `describe-function'." (defun gnus-button-handle-apropos (url) "Call `apropos' when pushing the corresponding URL button." - (apropos (replace-regexp-in-string - url gnus-button-handle-describe-prefix ""))) + (apropos (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))) (defun gnus-button-handle-apropos-command (url) "Call `apropos' when pushing the corresponding URL button." (apropos-command - (replace-regexp-in-string url gnus-button-handle-describe-prefix ""))) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))) (defun gnus-button-handle-apropos-variable (url) "Call `apropos' when pushing the corresponding URL button." (funcall (if (fboundp 'apropos-variable) 'apropos-variable 'apropos) - (replace-regexp-in-string url gnus-button-handle-describe-prefix ""))) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))) (defun gnus-button-handle-apropos-documentation (url) "Call `apropos' when pushing the corresponding URL button." (funcall (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos) - (replace-regexp-in-string url gnus-button-handle-describe-prefix ""))) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))) (defun gnus-button-handle-library (url) "Call `locate-library' when pushing the corresponding URL button." (gnus-message 9 "url=`%s'" url) (let* ((lib (locate-library url)) - (file (replace-regexp-in-string (or lib "") "\\.elc" ".el"))) + (file (replace-regexp-in-string "\\.elc" ".el" (or lib "")))) (if (not lib) (gnus-message 1 "Cannot locale library `%s'." url) (find-file-read-only file)))) @@ -8274,7 +8273,7 @@ url is put as the `gnus-button-url' overlay property on the button." "Fetch a man page." (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) (when (eq gnus-button-man-handler 'woman) - (setq url (replace-regexp-in-string url "([1-9][X1a-z]*).*\\'" ""))) + (setq url (replace-regexp-in-string "([1-9][X1a-z]*).*\\'" "" url))) (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) (funcall gnus-button-man-handler url)) @@ -8290,7 +8289,7 @@ url is put as the `gnus-button-url' overlay property on the button." ((string-match "([^)\"]+)[^\"]+" url) (setq url (replace-regexp-in-string - (replace-regexp-in-string url "[\n\t ]+" " ") "\"" "")) + "\"" "" (replace-regexp-in-string "[\n\t ]+" " " url))) (gnus-info-find-node url)) (t (error "Can't parse %s" url)))) @@ -8429,8 +8428,8 @@ url is put as the `gnus-button-url' overlay property on the button." (funcall func) (message-position-on-field (caar args))) (insert (replace-regexp-in-string - (mapconcat 'identity (reverse (cdar args)) ", ") - "\r\n" "\n" t)) + "\r\n" "\n" + (mapconcat 'identity (reverse (cdar args)) ", ") nil t)) (setq args (cdr args))) (if subject (message-goto-body) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index cb3de92..66fc610 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -226,7 +226,7 @@ So the cdr of each bookmark is an alist too.") "-" (car subject) "-" (cadr subject))) (default-name-1 ;; Strip "[]" chars from the bookmark name: - (replace-regexp-in-string default-name-0 "[]_[]" "")) + (replace-regexp-in-string "[]_[]" "" default-name-0)) (name (read-from-minibuffer (format "Set bookmark (%s): " default-name-1) nil nil nil nil diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index 28caed2..89be864 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -95,7 +95,8 @@ Set image category to CATEGORY." (when (if real-name (re-search-forward (concat (replace-regexp-in-string - (regexp-quote real-name) "[\t ]+" "[\t\n ]+") + "[\t ]+" "[\t\n ]+" + (regexp-quote real-name)) "\\|" (regexp-quote mail-address)) nil t) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 18e899b..b702e2f 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2197,7 +2197,7 @@ if it is not a list." (setq group (encode-coding-string group (gnus-group-name-charset nil group)))) - (replace-regexp-in-string group "\n" ""))) + (replace-regexp-in-string "\n" "" group))) ;;;###autoload (defun gnus-fetch-group (group &optional articles) @@ -2456,8 +2456,8 @@ the bug number, and browsing the URL must return mbox output." (end-of-line) (insert (format ", %s@%s" (car ids) (replace-regexp-in-string - (replace-regexp-in-string mbox-url "^http://" "") - "/.*$" "")))))) + "/.*$" "" + (replace-regexp-in-string "^http://" "" mbox-url))))))) (gnus-group-read-ephemeral-group (format "nndoc+ephemeral:bug#%s" (mapconcat 'number-to-string ids ",")) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index dec0e4e..43a4969 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1135,8 +1135,8 @@ See the variable `gnus-user-agent'." (when (memq 'gnus gnus-user-agent) (concat "Gnus/" (replace-regexp-in-string - (format "%1.8f" (gnus-continuum-version gnus-version)) - "0+\\'" "") + "0+\\'" "" + (format "%1.8f" (gnus-continuum-version gnus-version))) " (" gnus-version ")"))) (emacs-v (gnus-emacs-version))) (concat gnus-v (when (and gnus-v emacs-v) " ") diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index dfdf8e1..688646f 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9085,7 +9085,7 @@ non-numeric or nil fetch the number specified by the (gnus-warp-to-article) (when (and (stringp message-id) (not (zerop (length message-id)))) - (setq message-id (replace-regexp-in-string message-id " " "")) + (setq message-id (replace-regexp-in-string " " "" message-id)) ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. (unless (string-match "^<" message-id) @@ -9563,10 +9563,10 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (defun gnus-summary-print-truncate-and-quote (string &optional len) "Truncate to LEN and quote all \"(\"'s in STRING." - (replace-regexp-in-string (if (and len (> (length string) len)) + (replace-regexp-in-string "[()]" "\\\\\\&" + (if (and len (> (length string) len)) (substring string 0 len) - string) - "[()]" "\\\\\\&")) + string))) (defun gnus-summary-print-article (&optional filename n) "Generate and print a PostScript image of the process-marked (mail) articles. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index eee80fd..284f094 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -407,7 +407,7 @@ Cache the result as a text property stored in DATE." (defun gnus-mode-string-quote (string) "Quote all \"%\"'s in STRING." - (replace-regexp-in-string string "%" "%%")) + (replace-regexp-in-string "%" "%%" string)) ;; Make a hash table (default and minimum size is 256). ;; Optional argument HASHSIZE specifies the table size. diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index d360f5f..2388a1a 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -603,8 +603,8 @@ If CONFIRM is non-nil, ask for confirmation before removing a file." currday (+ currday (* low2days (nth 1 (current-time))))) (while files (let* ((ffile (car files)) - (bfile (replace-regexp-in-string - ffile "\\`.*/\\([^/]+\\)\\'" "\\1")) + (bfile (replace-regexp-in-string "\\`.*/\\([^/]+\\)\\'" "\\1" + ffile)) (filetime (nth 5 (file-attributes ffile))) (fileday (* (car filetime) high2days)) (fileday (+ fileday (* low2days (nth 1 filetime))))) diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index a82768f..609a8f4 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -1028,11 +1028,12 @@ If FORCE, re-parse even if already parsed." (replace-regexp-in-string ;; Replace mailcap's `%s' placeholder ;; with dired's `?' placeholder + "%s" "?" (replace-regexp-in-string ;; Remove the final filename placeholder - command "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" - nil t) - "%s" "?" nil t)))) + "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" + command nil t) + nil t)))) common-mime-info))))) commands)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 540736c..0a80646 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8309,7 +8309,8 @@ From headers in the original article." (dolist (string (mail-header-parse-addresses value 'raw)) (setq string (replace-regexp-in-string - (replace-regexp-in-string string "^ +\\| +$" "") "\n" "")) + "\n" "" + (replace-regexp-in-string "^ +\\| +$" "" string))) (ecomplete-add-item 'mail (car (mail-header-parse-address string)) string)))) (ecomplete-save)) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index c861b9a..383aede 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1353,12 +1353,12 @@ string if you do not like underscores." (defun mm-file-name-delete-control (filename) "Delete control characters from FILENAME." - (replace-regexp-in-string filename "[\x00-\x1f\x7f]" "")) + (replace-regexp-in-string "[\x00-\x1f\x7f]" "" filename)) (defun mm-file-name-delete-gotchas (filename) "Delete shell gotchas from FILENAME." - (setq filename (replace-regexp-in-string filename "[<>|]" "")) - (replace-regexp-in-string filename "^[.-]+" "")) + (setq filename (replace-regexp-in-string "[<>|]" "" filename)) + (replace-regexp-in-string "^[.-]+" "" filename)) (defun mm-save-part (handle &optional prompt) "Write HANDLE to a file. diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index a36dba4..7614002 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -929,16 +929,17 @@ ready to be added to the list of search results." ;; Set group to dirnam without any leading dots or slashes, ;; and with all subsequent slashes replaced by dots (let ((group (replace-regexp-in-string - (replace-regexp-in-string dirnam "^[./\\]" "" nil t) - "[/\\]" "." nil t))) - - (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)) - group nil) - (string-to-number article)) - (string-to-number score))))) + "[/\\]" "." + (replace-regexp-in-string "^[./\\]" "" dirnam nil t) + nil t))) + + (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)) + group nil) + (string-to-number article)) + (string-to-number score))))) ;;; Search Engine Interfaces: @@ -1341,9 +1342,9 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (string-match "^[./\\]*\\(.*\\)$" dirnam) ;; "/" -> "." (setq group (replace-regexp-in-string - (match-string 1 dirnam) "/" ".")) + "/" "." (match-string 1 dirnam))) ;; Windows "\\" -> "." - (setq group (replace-regexp-in-string group "\\\\" ".")) + (setq group (replace-regexp-in-string "\\\\" "." group)) (push (vector (gnus-group-full-name group server) (string-to-number artno) @@ -1415,7 +1416,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) + (replace-regexp-in-string "/" "." dirnam) server) (string-to-number artno) (string-to-number score)) artlist)) @@ -1614,7 +1615,8 @@ actually)." (if (file-directory-p (setq group (replace-regexp-in-string - group "\\." "/" nil t))) + "\\." "/" + group nil t))) group)))))) (unless group (error "Cannot locate directory for group")) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 4b15443..e34a13b 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -657,12 +657,12 @@ by nnmaildir-request-article.") (defun nnmaildir--system-name () (replace-regexp-in-string + ":" "\\072" (replace-regexp-in-string - (replace-regexp-in-string - (system-name) - "\\\\" "\\134" nil 'literal) - "/" "\\057" nil 'literal) - ":" "\\072" nil 'literal)) + "/" "\\057" + (replace-regexp-in-string "\\\\" "\\134" (system-name) nil 'literal) + nil 'literal) + nil 'literal)) (defun nnmaildir-request-type (_group &optional _article) 'mail) @@ -956,7 +956,8 @@ by nnmaildir-request-article.") group (symbol-value group) ro (nnmaildir--param pgname 'read-only)) (insert (replace-regexp-in-string - (nnmaildir--grp-name group) " " "\\ " nil t) + " " "\\ " + (nnmaildir--grp-name group) nil t) " ") (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) nntp-server-buffer) @@ -985,7 +986,7 @@ by nnmaildir-request-article.") (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) nntp-server-buffer) (insert " " - (replace-regexp-in-string gname " " "\\ " nil t) + (replace-regexp-in-string " " "\\ " gname nil t) "\n"))))) 'group) @@ -1116,7 +1117,7 @@ by nnmaildir-request-article.") (insert " ") (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) nntp-server-buffer) - (insert " " (replace-regexp-in-string gname " " "\\ " nil t) "\n") + (insert " " (replace-regexp-in-string " " "\\ " gname nil t) "\n") t)))) (defun nnmaildir-request-create-group (gname &optional server _args) @@ -1278,7 +1279,7 @@ by nnmaildir-request-article.") (insert "\t" (nnmaildir--nov-get-beg nov) "\t" (nnmaildir--art-msgid article) "\t" (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " - (replace-regexp-in-string gname " " "\\ " nil t) ":") + (replace-regexp-in-string " " "\\ " gname nil t) ":") (princ num nntp-server-buffer) (insert "\t" (nnmaildir--nov-get-end nov) "\n")))) (catch 'return diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 5b471e8..4976f25 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -1078,7 +1078,6 @@ Use the nov database for the current group if available." (let* ((oldfile (nnml-article-to-file old-number)) (newfile (replace-regexp-in-string - oldfile ;; nnml-use-compressed-files might be any string, but ;; probably it's sufficient to take into account only ;; "\\.[a-z0-9]+". Note that we can't only use the @@ -1087,7 +1086,8 @@ Use the nov database for the current group if available." ;; value. (concat "\\(" old-number-string "\\)\\(\\(\\.[a-z0-9]+\\)?\\)$") - (concat new-number-string "\\2")))) + (concat new-number-string "\\2") + oldfile))) (with-current-buffer nntp-server-buffer (nnmail-find-file oldfile) ;; Update the Xref header in the article itself: diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 6d2d16a..6168e5a 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -111,7 +111,7 @@ for decoding when the cdr that the data specify is not available.") ;;; Interface functions (defsubst nnrss-format-string (string) - (replace-regexp-in-string string " *\n *" " ")) + (replace-regexp-in-string " *\n *" " " string)) (defun nnrss-decode-group-name (group) (if (and group (mm-coding-system-p 'utf-8)) @@ -291,7 +291,7 @@ for decoding when the cdr that the data specify is not available.") (let ((rfc2047-encoding-type 'mime) rfc2047-encode-max-chars) (rfc2047-encode-string - (replace-regexp-in-string group "[\t\n ]+" "_"))))) + (replace-regexp-in-string "[\t\n ]+" "_" group))))) (when nnrss-content-function (funcall nnrss-content-function e group article)))) (cond @@ -804,9 +804,10 @@ It is useful when `(setq nnrss-use-local t)'." node)) (cleaned-text (if text (replace-regexp-in-string + "\r\n" "\n" (replace-regexp-in-string - text "^[\000-\037\177]+\\|^ +\\| +$" "") - "\r\n" "\n")))) + "^[\000-\037\177]+\\|^ +\\| +$" "" + text))))) (if (string-equal "" cleaned-text) nil cleaned-text))) diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index eb7d862..0b58dc8 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -163,12 +163,12 @@ submitted at once. Internal variable.") (concat "/" (replace-regexp-in-string + "/" ":" (replace-regexp-in-string + "^.*article.gmane.org/" "" (replace-regexp-in-string - (mail-header-xref (gnus-summary-article-header article)) - "/raw" ":silent") - "^.*article.gmane.org/" "") - "/" ":")))) + "/raw" ":silent" + (mail-header-xref (gnus-summary-article-header article)))))))) (spam-report-gmane-use-article-number (spam-report-url-ping rpt-host @@ -207,8 +207,8 @@ submitted at once. Internal variable.") (when host (when (string-equal "permalink.gmane.org" host) (setq host rpt-host) - (setq report (replace-regexp-in-string - report "/\\([0-9]+\\)$" ":\\1"))) + (setq report (replace-regexp-in-string "/\\([0-9]+\\)$" ":\\1" + report))) (setq url (format "http://%s%s" host report))) (if (not (and host report url)) (gnus-message @@ -227,7 +227,7 @@ the function specified by `spam-report-url-ping-function'." (defcustom spam-report-user-mail-address (and (stringp user-mail-address) - (replace-regexp-in-string user-mail-address "@" "")) + (replace-regexp-in-string "@" "" user-mail-address)) "Mail address of this user used for spam reports to Gmane. This is initialized based on `user-mail-address'." :type '(choice string diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 39181ea..d322400 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -1200,18 +1200,18 @@ Note this has to be fast." (cond ((eq header 'X-Spam-Status) (string-to-number (replace-regexp-in-string - header-content spam-spamassassin-score-regexp - "\\1"))) + "\\1" + header-content))) ;; for CRM checking, it's probably faster to just do the string match ((string-match "( pR: \\([0-9.-]+\\)" header-content) (- (string-to-number (match-string 1 header-content)))) ((eq header 'X-Bogosity) (string-to-number (replace-regexp-in-string + ",.*" "" (replace-regexp-in-string - header-content - ".*spamicity=" "") - ",.*" ""))) + ".*spamicity=" "" + header-content)))) (t nil)) nil))) commit 2a342bda0af6c0bc168a190f368f0871ff31f7b1 Author: Lars Ingebrigtsen Date: Fri Feb 12 17:59:59 2016 +1100 Silence more message.el compilation warnings * lisp/gnus/message.el (message-generate-headers): Don't use variable values directly to get the header values, because that breaks with lexical binding (without unprefixed defvars). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 7cf5019..540736c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5945,41 +5945,27 @@ See `message-idna-encode'." (message-idna-to-ascii-rhs-1 "Mail-Followup-To") (message-idna-to-ascii-rhs-1 "Cc"))))) -(defvar Date) -(defvar Message-ID) -(defvar Organization) -(defvar From) -(defvar Path) -(defvar Subject) -(defvar Newsgroups) -(defvar In-Reply-To) -(defvar References) -(defvar To) -(defvar Distribution) -(defvar Lines) -(defvar User-Agent) -(defvar Expires) - (defun message-generate-headers (headers) "Prepare article HEADERS. Headers already prepared in the buffer are not modified." (setq headers (append headers message-required-headers)) (save-restriction (message-narrow-to-headers) - (let* ((Date (message-make-date)) - (Message-ID (message-make-message-id)) - (Organization (message-make-organization)) - (From (message-make-from)) - (Path (message-make-path)) - (Subject nil) - (Newsgroups nil) - (In-Reply-To (message-make-in-reply-to)) - (References (message-make-references)) - (To nil) - (Distribution (message-make-distribution)) - (Lines (message-make-lines)) - (User-Agent message-newsreader) - (Expires (message-make-expires)) + (let* ((header-values + (list 'Date (message-make-date) + 'Message-ID (message-make-message-id) + 'Organization (message-make-organization) + 'From (message-make-from) + 'Path (message-make-path) + 'Subject nil + 'Newsgroups nil + 'In-Reply-To (message-make-in-reply-to) + 'References (message-make-references) + 'To nil + 'Distribution (message-make-distribution) + 'Lines (message-make-lines) + 'User-Agent message-newsreader + 'Expires (message-make-expires))) (case-fold-search t) (optionalp nil) header value elem header-string) @@ -6033,8 +6019,8 @@ Headers already prepared in the buffer are not modified." (setq header (cdr elem)) (or (and (functionp (cdr elem)) (funcall (cdr elem))) - (and (boundp (cdr elem)) - (symbol-value (cdr elem))))) + (and (symbolp (cdr elem)) + (plist-get header-values (cdr elem))))) ((consp elem) ;; The element is a cons. Either the cdr is a ;; string to be inserted verbatim, or it is a @@ -6044,11 +6030,11 @@ Headers already prepared in the buffer are not modified." (cdr elem)) (and (functionp (cdr elem)) (funcall (cdr elem))))) - ((and (boundp header) - (symbol-value header)) - ;; The element is a symbol. We insert the value - ;; of this symbol, if any. - (symbol-value header)) + ((and (symbolp header) + (plist-member header-values header)) + ;; The element is a symbol. We insert the value of + ;; this symbol, if any. + (plist-get header-values header)) ((not (message-check-element (intern (downcase (symbol-name header))))) ;; We couldn't generate a value for this header, commit 209e8bd102ac65bf5ae1a4aad56d21a097536f9a Author: Lars Ingebrigtsen Date: Fri Feb 12 17:28:10 2016 +1100 Fix various compilation warnings in message.el * lisp/gnus/message.el (message-fix-before-sending): Use read-multiple-choice instead of gnus-multiple-choice. (mm-util): Require. (rfc2047): Require. (message-remove-blank-cited-lines): Use message instead of gnus-message. (message-send): Use y-or-n-p instead of gnus-y-or-n-p. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index dec4c37..7cf5019 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -46,6 +46,8 @@ (require 'rfc822) (require 'format-spec) (require 'dired) +(require 'mm-util) +(require 'rfc2047) (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ @@ -3764,7 +3766,7 @@ To use this automatically, you may add this function to message-yank-prefix "\\)+ *\n" ))) - (gnus-message 8 "removing `%s'" citexp) + (message "removing `%s'" citexp) (save-excursion (message-goto-body) (while (re-search-forward citexp nil t) @@ -4185,7 +4187,7 @@ It should typically alter the sending method in some way or other." (or (eq message-allow-no-recipients 'always) (and (not (eq message-allow-no-recipients 'never)) (setq dont-barf-on-no-method - (gnus-y-or-n-p + (y-or-n-p (format "No receiver, perform %s anyway? " (cond ((and fcc gcc) "Fcc and Gcc") (fcc "Fcc") @@ -4333,16 +4335,18 @@ conformance." (forward-char)) (when found (setq choice - (gnus-multiple-choice - (if nul-chars - "NUL characters found, which may cause problems. Continue sending?" - "Non-printable characters found. Continue sending?") - `((?d "Remove non-printable characters and send") - (?r ,(format - "Replace non-printable characters with \"%s\" and send" - message-replacement-char)) - (?s "Send as is without removing anything") - (?e "Continue editing")))) + (car + (read-multiple-choice + (if nul-chars + "NUL characters found, which may cause problems. Continue sending?" + "Non-printable characters found. Continue sending?") + `((?d "delete" "Remove non-printable characters and send") + (?r "replace" + ,(format + "Replace non-printable characters with \"%s\" and send" + message-replacement-char)) + (?s "send" "Send as is without removing anything") + (?e "edit" "Continue editing"))))) (if (eq choice ?e) (error "Non-printable characters")) (message-goto-body) commit b731dcde62afe28b03d4bf9cd2ca27693b82610a Author: Lars Ingebrigtsen Date: Fri Feb 12 17:23:43 2016 +1100 Silence compilation warning in mm-view * lisp/gnus/mm-view.el (mm-display-inline-fontify): Silence compilation warning. diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index ba77410..518b740 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -497,9 +497,7 @@ If MODE is not set, try to find mode automatically." ;; Do not fontify if the guess mode is fundamental. (unless (or font-lock-mode (eq major-mode 'fundamental-mode)) - (if (fboundp 'font-lock-ensure) - (font-lock-ensure) - (font-lock-fontify-buffer))))) + (font-lock-ensure)))) (setq text (buffer-string)) ;; Set buffer unmodified to avoid confirmation when killing the ;; buffer. commit 93c3363523be0df353ddd9653494bec8dc57fd8c Author: Lars Ingebrigtsen Date: Fri Feb 12 17:21:33 2016 +1100 Fix epg-related compilation warnings in mml-sec * lisp/gnus/mml-sec.el: Fix compilation warnings from the epg library. diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 5bfed9f..e23fb1a 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -27,6 +27,9 @@ (require 'gnus-util) (require 'epg) +(require 'epa) +(require 'password-cache) +(require 'mm-encode) (autoload 'mail-strip-quoted-names "mail-utils") (autoload 'mml2015-sign "mml2015") @@ -43,6 +46,8 @@ (autoload 'mml-smime-verify "mml-smime") (autoload 'mml-smime-verify-test "mml-smime") (autoload 'epa--select-keys "epa") +(autoload 'message-options-get "message") +(autoload 'message-options-set "message") (defvar mml-sign-alist '(("smime" mml-smime-sign-buffer mml-smime-sign-query) @@ -110,10 +115,7 @@ details." :group 'message :type 'boolean) -(defcustom mml-secure-cache-passphrase - (if (boundp 'password-cache) - password-cache - t) +(defcustom mml-secure-cache-passphrase password-cache "If t, cache OpenPGP or S/MIME passphrases inside Emacs. Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead. See Info node `(message) Security'." @@ -623,7 +625,7 @@ Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead." The passphrase is read and cached." ;; Based on mml2015-epg-passphrase-callback. (if (eq key-id 'SYM) - (epg-passphrase-callback-function context key-id nil) + (epa-passphrase-callback-function context key-id nil) (let* ((password-cache-key-id (if (eq key-id 'PIN) "PIN" @@ -907,10 +909,10 @@ If no one is selected, symmetric encryption will be performed. " cipher signers) (when sign (setq signers (mml-secure-signers context signer-names)) - (epg-context-set-signers context signers)) + (setf (epg-context-signers context) signers)) (when (eq 'OpenPGP protocol) - (epg-context-set-armor context t) - (epg-context-set-textmode context t)) + (setf (epg-context-armor context) t) + (setf (epg-context-textmode context) t)) (when (mml-secure-cache-passphrase-p protocol) (epg-context-set-passphrase-callback context @@ -935,9 +937,9 @@ If no one is selected, symmetric encryption will be performed. " (signers (mml-secure-signers context signer-names)) signature micalg) (when (eq 'OpenPGP protocol) - (epg-context-set-armor context t) - (epg-context-set-textmode context t)) - (epg-context-set-signers context signers) + (setf (epg-context-armor context) t) + (setf (epg-context-textmode context) t)) + (setf (epg-context-signers context) signers) (when (mml-secure-cache-passphrase-p protocol) (epg-context-set-passphrase-callback context commit d3560e0af4d27e423a2acd7c6a40a47305255a34 Author: Lars Ingebrigtsen Date: Fri Feb 12 17:15:11 2016 +1100 rmail-dont-reply-to-names is obsolete * lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): Don't bind the obsolete `rmail-dont-reply-to-names' variable. diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index ae322b7..b8899f4 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1950,10 +1950,8 @@ If TIME is nil, then return the cutoff time for oldness instead." ((and (equal header 'to-from) (or (string-match (cadr regexp-target-pair) from) (and (string-match (cadr regexp-target-pair) to) - (let* ((mail-dont-reply-to-names - (message-dont-reply-to-names)) - (rmail-dont-reply-to-names ; obsolete since 24.1 - mail-dont-reply-to-names)) + (let ((mail-dont-reply-to-names + (message-dont-reply-to-names))) (equal (if (fboundp 'rmail-dont-reply-to) (rmail-dont-reply-to from) (mail-dont-reply-to from)) ""))))) commit 0ff58f69651faa1aa36ff45d4012a19938642412 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:55:23 2016 +1100 Partially revert the defmethod->cl-defmethod change in registry.el * lisp/gnus/registry.el (initialize-instance): Use defmethod, since cl-defmethod doesn't work with :after. (initialize-instance): Ditto, but with :before. diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index 9182920..d89ba48 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el @@ -129,7 +129,7 @@ :type hash-table :documentation "The data hashtable."))) -(cl-defmethod initialize-instance :BEFORE ((this registry-db) slots) +(defmethod initialize-instance :BEFORE ((this registry-db) slots) "Check whether a registry object needs to be upgraded." ;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the ;; :max-soft slot to disappear, and the :max-hard slot to be renamed @@ -146,7 +146,7 @@ (cl-remf slots :max-hard) (cl-remf slots :max-soft)))) -(cl-defmethod initialize-instance :AFTER ((this registry-db) slots) +(defmethod initialize-instance :AFTER ((this registry-db) slots) "Set value of data slot of THIS after initialization." (with-slots (data tracker) this (unless (member :data slots) commit 210a895757fc89138a7ec21cbf7fc8cb14b3c0b8 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:49:01 2016 +1100 Avoid obsolete function in plstore * lisp/gnus/plstore.el (plstore--insert-buffer): Use setf instead of the obsolete epg-context-set-armor. diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el index 5685590..62c50c0 100644 --- a/lisp/gnus/plstore.el +++ b/lisp/gnus/plstore.el @@ -422,7 +422,7 @@ SECRET-KEYS is a plist containing secret data." ((listp plstore-encrypt-to) plstore-encrypt-to) ((stringp plstore-encrypt-to) (list plstore-encrypt-to)))) cipher) - (epg-context-set-armor context t) + (setf (epg-context-armor context) t) (epg-context-set-passphrase-callback context (cons #'plstore-passphrase-callback-function commit ba9c534b955c3f0ef6dac7b2ecc1a125507b481c Author: Lars Ingebrigtsen Date: Fri Feb 12 16:45:30 2016 +1100 Use cl-defmethod in registry.el * lisp/gnus/registry.el: Use cl-defmethod instead of the obsolete defmethod. diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index 9e6babc..9182920 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el @@ -129,7 +129,7 @@ :type hash-table :documentation "The data hashtable."))) -(defmethod initialize-instance :BEFORE ((this registry-db) slots) +(cl-defmethod initialize-instance :BEFORE ((this registry-db) slots) "Check whether a registry object needs to be upgraded." ;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the ;; :max-soft slot to disappear, and the :max-hard slot to be renamed @@ -146,7 +146,7 @@ (cl-remf slots :max-hard) (cl-remf slots :max-soft)))) -(defmethod initialize-instance :AFTER ((this registry-db) slots) +(cl-defmethod initialize-instance :AFTER ((this registry-db) slots) "Set value of data slot of THIS after initialization." (with-slots (data tracker) this (unless (member :data slots) @@ -155,7 +155,7 @@ (unless (member :tracker slots) (setq tracker (make-hash-table :size 100 :rehash-size 2.0))))) -(defmethod registry-lookup ((db registry-db) keys) +(cl-defmethod registry-lookup ((db registry-db) keys) "Search for KEYS in the registry-db THIS. Returns an alist of the key followed by the entry in a list, not a cons cell." (let ((data (oref db data))) @@ -166,7 +166,7 @@ Returns an alist of the key followed by the entry in a list, not a cons cell." (list k (gethash k data)))) keys)))) -(defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys) +(cl-defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys) "Search for KEYS in the registry-db THIS. Returns an alist of the key followed by the entry in a list, not a cons cell." (let ((data (oref db data))) @@ -175,8 +175,8 @@ Returns an alist of the key followed by the entry in a list, not a cons cell." when (gethash key data) collect (list key (gethash key data)))))) -(defmethod registry-lookup-secondary ((db registry-db) tracksym - &optional create) +(cl-defmethod registry-lookup-secondary ((db registry-db) tracksym + &optional create) "Search for TRACKSYM in the registry-db THIS. When CREATE is not nil, create the secondary index hashtable if needed." (let ((h (gethash tracksym (oref db :tracker)))) @@ -188,8 +188,8 @@ When CREATE is not nil, create the secondary index hashtable if needed." (oref db tracker)) (gethash tracksym (oref db tracker)))))) -(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val - &optional set) +(cl-defmethod registry-lookup-secondary-value ((db registry-db) tracksym val + &optional set) "Search for TRACKSYM with value VAL in the registry-db THIS. When SET is not nil, set it for VAL (use t for an empty list)." ;; either we're asked for creation or there should be an existing index @@ -220,7 +220,7 @@ When SET is not nil, set it for VAL (use t for an empty list)." (or found (registry--match mode entry (cdr-safe check-list)))))) -(defmethod registry-search ((db registry-db) &rest spec) +(cl-defmethod registry-search ((db registry-db) &rest spec) "Search for SPEC across the registry-db THIS. For example calling with `:member \\='(a 1 2)' will match entry \((a 3 1)). Calling with `:all t' (any non-nil value) will match all. @@ -241,7 +241,7 @@ The test order is to check :all first, then :member, then :regex." (and regex (registry--match :regex v regex))) collect k)))) -(defmethod registry-delete ((db registry-db) keys assert &rest spec) +(cl-defmethod registry-delete ((db registry-db) keys assert &rest spec) "Delete KEYS from the registry-db THIS. If KEYS is nil, use SPEC to do a search. Updates the secondary ('tracked') indices as well. @@ -274,17 +274,17 @@ With assert non-nil, errors out if the key does not exist already." (remhash key data))) keys)) -(defmethod registry-size ((db registry-db)) +(cl-defmethod registry-size ((db registry-db)) "Returns the size of the registry-db object THIS. This is the key count of the `data' slot." (hash-table-count (oref db data))) -(defmethod registry-full ((db registry-db)) +(cl-defmethod registry-full ((db registry-db)) "Checks if registry-db THIS is full." (>= (registry-size db) (oref db max-size))) -(defmethod registry-insert ((db registry-db) key entry) +(cl-defmethod registry-insert ((db registry-db) key entry) "Insert ENTRY under KEY into the registry-db THIS. Updates the secondary ('tracked') indices as well. Errors out if the key exists already." @@ -308,7 +308,7 @@ Errors out if the key exists already." (registry-lookup-secondary-value db tr val value-keys)))) entry) -(defmethod registry-reindex ((db registry-db)) +(cl-defmethod registry-reindex ((db registry-db)) "Rebuild the secondary indices of registry-db THIS." (let ((count 0) (expected (* (length (oref db tracked)) (registry-size db)))) @@ -327,7 +327,7 @@ Errors out if the key exists already." (registry-lookup-secondary-value db tr val value-keys)))) (oref db data)))))) -(defmethod registry-prune ((db registry-db) &optional sortfunc) +(cl-defmethod registry-prune ((db registry-db) &optional sortfunc) "Prunes the registry-db object DB. Attempts to prune the number of entries down to \(* @@ -354,7 +354,8 @@ Returns the number of deleted entries." (length (registry-delete db candidates nil))) 0))) -(defmethod registry-collect-prune-candidates ((db registry-db) limit sortfunc) +(cl-defmethod registry-collect-prune-candidates ((db registry-db) + limit sortfunc) "Collects pruning candidates from the registry-db object DB. Proposes only entries without the :precious keys, and attempts to commit b78a7596f684dd6cde814dacd220471bc8ea18a0 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:40:48 2016 +1100 Make sieve-manage require sasl * lisp/gnus/sieve-manage.el: Fix compilation warning by requiring sasl. diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index 212a7fd..dd503c3 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -75,10 +75,9 @@ (require 'password-cache) (require 'password)) -(eval-when-compile - (require 'cl) ; caddr - (require 'sasl) - (require 'starttls)) +(eval-when-compile (require 'cl)) +(require 'sasl) +(require 'starttls) (autoload 'sasl-find-mechanism "sasl") (autoload 'auth-source-search "auth-source") commit b721d0a1e425b16821edea7dc195979fa010b0e9 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:38:14 2016 +1100 Avoid defvarring prefix-less variable * lisp/gnus/mm-uu.el (mm-uu-entry): Rename from `entry'. diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index b1ff318..fec3b29 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -312,13 +312,13 @@ apply the face `mm-uu-extract'." (interactive) (if symbol (set-default symbol value)) (setq mm-uu-beginning-regexp nil) - (mapcar (lambda (entry) - (if (mm-uu-configure-p (mm-uu-type entry) 'disabled) + (mapcar (lambda (mm-uu-entry) + (if (mm-uu-configure-p (mm-uu-type mm-uu-entry) 'disabled) nil (setq mm-uu-beginning-regexp (concat mm-uu-beginning-regexp (if mm-uu-beginning-regexp "\\|") - (mm-uu-beginning-regexp entry))))) + (mm-uu-beginning-regexp mm-uu-entry))))) mm-uu-type-alist)) (mm-uu-configure) @@ -326,7 +326,7 @@ apply the face `mm-uu-extract'." (defvar file-name) (defvar start-point) (defvar end-point) -(defvar entry) +(defvar mm-uu-entry) (defun mm-uu-uu-filename () (if (looking-at ".+") @@ -602,10 +602,10 @@ apply the face `mm-uu-extract'." (defun mm-uu-gpg-key-skip-to-last () (let ((point (point)) - (end-regexp (mm-uu-end-regexp entry)) - (beginning-regexp (mm-uu-beginning-regexp entry))) + (end-regexp (mm-uu-end-regexp mm-uu-entry)) + (beginning-regexp (mm-uu-beginning-regexp mm-uu-entry))) (when (and end-regexp - (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))) + (not (mm-uu-configure-p (mm-uu-type mm-uu-entry) 'disabled))) (while (re-search-forward end-regexp nil t) (skip-chars-forward " \t\n\r") (if (looking-at beginning-regexp) commit 6da254012c2563e83d7f43ab1e33193bc2e4626f Author: Lars Ingebrigtsen Date: Fri Feb 12 16:35:23 2016 +1100 * lisp/gnus/mailcap.el: Remove usage of mailcap-delete-duplicates. diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index de8e838..a82768f 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -995,14 +995,14 @@ If FORCE, re-parse even if already parsed." (mailcap-parse-mimetypes) (let* ((all-mime-type ;; All unique MIME types from file extensions - (mailcap-delete-duplicates + (delete-dups (mapcar (lambda (file) (mailcap-extension-to-mime (file-name-extension file t))) files))) (all-mime-info ;; All MIME info lists - (mailcap-delete-duplicates + (delete-dups (mapcar (lambda (mime-type) (mailcap-mime-info mime-type 'all)) all-mime-type))) @@ -1020,7 +1020,7 @@ If FORCE, re-parse even if already parsed." (car all-mime-info))) (commands ;; Command strings from `viewer' field of the MIME info - (mailcap-delete-duplicates + (delete-dups (delq nil (mapcar (lambda (mime-info) (let ((command (cdr (assoc 'viewer mime-info)))) commit 7c162e73d471242c5cb649db3e50d1a5787127ab Author: Lars Ingebrigtsen Date: Fri Feb 12 16:33:36 2016 +1100 Don't use the obsolete char-valid-p function * lisp/gnus/mm-url.el (mm-url-decode-entities): Don't use the obsolete char-valid-p function. diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 25954b9..fb11d7a 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -364,7 +364,7 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (string-to-number (substring entity 1))))) (setq c (or (cdr (assq c mm-extra-numeric-entities)) (mm-ucs-to-char c))) - (if (char-valid-p c) c ?#)) + (if (characterp c) c ?#)) (or (cdr (assq (intern entity) mm-url-html-entities)) ?#)))) commit eefef287b35b5f5277de5246cb5806648be293b7 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:32:24 2016 +1100 Fix missed translation in a previous commit * lisp/gnus/mailcap.el (mailcap-mime-types): Fix missed translation of mailcap-delete-duplicates. diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index 7ceb865..de8e838 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -967,7 +967,7 @@ If FORCE, re-parse even if already parsed." (defun mailcap-mime-types () "Return a list of MIME media types." (mailcap-parse-mimetypes) - (mailcap-delete-duplicates + (delete-dups (nconc (mapcar 'cdr mailcap-mime-extensions) (apply commit ae6ad4776efa82333e4c65977bceb19cc187c4c7 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:30:55 2016 +1100 Avoid using mm-make-temp-file * lisp/gnus/mail-source.el (mail-source-delete-crash-box): Ditto. * lisp/gnus/mm-decode.el (mm-display-external): Ditto. * lisp/gnus/mml-smime.el (mml-smime-openssl-encrypt): Ditto. diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 6930616..d360f5f 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -639,7 +639,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) (let ((incoming - (mm-make-temp-file + (make-temp-file (expand-file-name mail-source-incoming-file-prefix mail-source-directory)))) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index d690014..c861b9a 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -915,7 +915,7 @@ external if displayed external." ;; The function is a string to be executed. (mm-insert-part handle) (mm-add-meta-html-tag handle) - (let* ((dir (mm-make-temp-file + (let* ((dir (make-temp-file (expand-file-name "emm." mm-tmp-directory) 'dir)) (filename (or (mail-content-type-get @@ -945,8 +945,8 @@ external if displayed external." ;; `mailcap-mime-extensions'. (setq suffix (car (rassoc (mm-handle-media-type handle) mailcap-mime-extensions)))) - (setq file (mm-make-temp-file (expand-file-name "mm." dir) - nil suffix)))) + (setq file (make-temp-file (expand-file-name "mm." dir) + nil suffix)))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) ;; The file is deleted after the viewer exists. If the users edits diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 02be62e..e7ee6e7 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -149,8 +149,7 @@ Whether the passphrase is cached at all is controlled by (if (not (and (not (file-exists-p tmp)) (get-buffer tmp))) (push tmp certfiles) - (setq file (mm-make-temp-file (expand-file-name "mml." - mm-tmp-directory))) + (setq file (make-temp-file (expand-file-name "mml." mm-tmp-directory))) (with-current-buffer tmp (write-region (point-min) (point-max) file)) (push file certfiles) commit 050f14e22e21148fac24f6b663b082bfb99a2016 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:28:45 2016 +1100 Fix compilation warning in gnus-start * lisp/gnus/gnus-start.el (gnus-slave-save-newsrc): Avoid mm-make-temp-file. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index b081a66..18b8686 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -3027,7 +3027,7 @@ If FORCE is non-nil, the .newsrc file is read." (defun gnus-slave-save-newsrc () (with-current-buffer gnus-dribble-buffer (let ((slave-name - (mm-make-temp-file (concat gnus-current-startup-file "-slave-"))) + (make-temp-file (concat gnus-current-startup-file "-slave-"))) (modes (ignore-errors (file-modes (concat gnus-current-startup-file ".eld"))))) (let ((coding-system-for-write gnus-ding-file-coding-system)) commit a8480fbc5af63fd9c60e7a490f50bf9cf7117873 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:25:13 2016 +1100 Avoid the obsoleted defmethod * lisp/gnus/gnus-icalendar.el: Use cl-defmethod instead of defmethod. diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 1cf372a..17faac4 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -119,17 +119,17 @@ nil "iCalendar class for REPLY events") -(defmethod gnus-icalendar-event:recurring-p ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:recurring-p ((event gnus-icalendar-event)) "Return t if EVENT is recurring." (not (null (gnus-icalendar-event:recur event)))) -(defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) "Return recurring frequency of EVENT." (let ((rrule (gnus-icalendar-event:recur event))) (string-match "FREQ=\\([[:alpha:]]+\\)" rrule) (match-string 1 rrule))) -(defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) "Return recurring interval of EVENT." (let ((rrule (gnus-icalendar-event:recur event)) (default-interval 1)) @@ -138,7 +138,7 @@ (or (match-string 1 rrule) default-interval))) -(defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) (defun gnus-icalendar-event--decode-datefield (event field zone-map) @@ -376,7 +376,7 @@ on the IDENTITIES list." (defvar gnus-icalendar-org-enabled-p nil) -(defmethod gnus-icalendar-event:org-repeat ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:org-repeat ((event gnus-icalendar-event)) "Return `org-mode' timestamp repeater string for recurring EVENT. Return nil for non-recurring EVENT." (when (gnus-icalendar-event:recurring-p event) @@ -390,7 +390,7 @@ Return nil for non-recurring EVENT." (when org-freq (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) -(defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." (let* ((start (gnus-icalendar-event:start-time event)) (end (gnus-icalendar-event:end-time event)) @@ -447,7 +447,7 @@ Return nil for non-recurring EVENT." (mapconcat #'identity participants ", ")) ;; TODO: make the template customizable -(defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) +(cl-defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) "Return string with new `org-mode' entry describing EVENT." (with-temp-buffer (org-mode) @@ -640,12 +640,12 @@ is searched." (org-agenda-list nil (gnus-icalendar-event:start event) duration-days))) -(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-request) reply-status) +(cl-defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-request) reply-status) (if (gnus-icalendar-find-org-event-file event) (gnus-icalendar--update-org-event event reply-status) (gnus-icalendar:org-event-save event reply-status))) -(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) reply-status) +(cl-defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) reply-status) (when (gnus-icalendar-find-org-event-file event) (gnus-icalendar--cancel-org-event event))) @@ -712,7 +712,7 @@ These will be used to retrieve the RSVP information from ical events." (mapcar #'regexp-quote gnus-icalendar-additional-identities))))) ;; TODO: make the template customizable -(defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status) +(cl-defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status) "Format an overview of EVENT details." (gmm-labels ((format-header (x) (format "%-12s%s" @@ -818,27 +818,27 @@ These will be used to retrieve the RSVP information from ical events." (defun gnus-icalendar-sync-event-to-org (event) (gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status)) -(defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) +(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) (when (gnus-icalendar-event:rsvp event) `(("Accept" gnus-icalendar-reply (,handle accepted ,event)) ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) ("Decline" gnus-icalendar-reply (,handle declined ,event))))) -(defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event-reply) handle) +(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event-reply) handle) "No buttons for REPLY events." nil) -(defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event)) (or (when gnus-icalendar-org-enabled-p (gnus-icalendar--get-org-event-reply-status event)) "Not replied yet")) -(defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event-reply)) +(cl-defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event-reply)) "No reply status for REPLY events." nil) -(defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event)) (let* ((org-entry-exists-p (gnus-icalendar-find-org-event-file event)) (export-button-text (if org-entry-exists-p "Update Org Entry" "Export to Org"))) @@ -850,7 +850,7 @@ These will be used to retrieve the RSVP information from ical events." `("Show Org Entry" gnus-icalendar--show-org-event ,event)))))) -(defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event-cancel)) +(cl-defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event-cancel)) (let ((org-entry-exists-p (gnus-icalendar-find-org-event-file event))) (delq nil (list commit 303390bda34f98b400798d5383cf0d722e35ba19 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:23:25 2016 +1100 Avoid defvarring prefix-less variables * lisp/gnus/gnus-group.el (gnus-group-update-eval-form): We don't need to `defvar' the short variables to allow `eval' to use them. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 18dd281..18e899b 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1612,8 +1612,6 @@ if it is a string, only list groups matching REGEXP." (defun gnus-group-update-eval-form (group list) "Eval `car' of each element of LIST, and return the first that return t. Some value are bound so the form can use them." - (defvar group-age) (defvar ticked) (defvar score) (defvar level) - (defvar mailp) (defvar total) (defvar unread) (when list (let* ((entry (gnus-group-entry group)) (unread (if (numberp (car entry)) (car entry) 0)) @@ -1633,25 +1631,6 @@ Some value are bound so the form can use them." (score (or (gnus-info-score info) 0)) (ticked (gnus-range-length (cdr (assq 'tick marked)))) (group-age (gnus-group-timestamp-delta group))) - ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465 - ;; ====================================================================== - ;; From: Richard Stallman - ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...]) - ;; Cc: ding@gnus.org - ;; Date: Sat, 27 Oct 2007 19:41:20 -0400 - ;; Message-ID: - ;; - ;; [...] - ;; The kludge is that the alist elements contain expressions that refer - ;; to local variables with short names. Perhaps write your own tiny - ;; evaluator that handles just `and', `or', and numeric comparisons - ;; and just a few specific variables. - ;; ====================================================================== - ;; - ;; Similar for other evaluated variables. Grep for risky-local-variable - ;; to find them! -- rsteib - ;; - ;; Eval the cars of the lists until we find a match. (while (and list (not (eval (caar list)))) (setq list (cdr list))) @@ -1662,8 +1641,8 @@ Some value are bound so the form can use them." GROUP is current group, and the line to highlight starts at BEG and ends at END." (let ((face (cdar (gnus-group-update-eval-form - group - gnus-group-highlight)))) + group + gnus-group-highlight)))) (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (let ((inhibit-read-only t)) (gnus-put-text-property-excluding-characters-with-faces commit ec9bd245eb4ebc84195f4c466bcb088068ad9de0 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:07:07 2016 +1100 nnweb doesn't need unibyte buffers * lisp/gnus/nnweb.el (nnweb-retrieve-headers) (nnweb-read-overview, nnweb-request-article) (nnweb-google-reference): Unibyte buffers are not needed here. diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 7552396..7fc4464 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -103,10 +103,9 @@ Valid types include `google', `dejanews', and `gmane'.") (with-current-buffer nntp-server-buffer (erase-buffer) (let (article header) - (mm-with-unibyte-current-buffer - (while (setq article (pop articles)) - (when (setq header (cadr (assq article nnweb-articles))) - (nnheader-insert-nov header)))) + (while (setq article (pop articles)) + (when (setq header (cadr (assq article nnweb-articles))) + (nnheader-insert-nov header))) 'nov))) (deffoo nnweb-request-scan (&optional group server) @@ -153,8 +152,7 @@ Valid types include `google', `dejanews', and `gmane'.") (let* ((header (cadr (assq article nnweb-articles))) (url (and header (mail-header-xref header)))) (when (or (and url - (mm-with-unibyte-current-buffer - (mm-url-insert url))) + (mm-url-insert url)) (and (stringp article) (nnweb-definition 'id t) (let ((fetch (nnweb-definition 'id)) @@ -164,8 +162,7 @@ Valid types include `google', `dejanews', and `gmane'.") (when (and fetch art) (setq url (format fetch (mm-url-form-encode-xwfu art))) - (mm-with-unibyte-current-buffer - (mm-url-insert url)) + (mm-url-insert url) (if (nnweb-definition 'reference t) (setq article (funcall (nnweb-definition @@ -215,17 +212,16 @@ Valid types include `google', `dejanews', and `gmane'.") (defun nnweb-read-overview (group) "Read the overview of GROUP and build the map." (when (file-exists-p (nnweb-overview-file group)) - (mm-with-unibyte-buffer - (nnheader-insert-file-contents (nnweb-overview-file group)) - (goto-char (point-min)) - (let (header) - (while (not (eobp)) - (setq header (nnheader-parse-nov)) - (forward-line 1) - (push (list (mail-header-number header) - header (mail-header-xref header)) - nnweb-articles) - (nnweb-set-hashtb header (car nnweb-articles))))))) + (nnheader-insert-file-contents (nnweb-overview-file group)) + (goto-char (point-min)) + (let (header) + (while (not (eobp)) + (setq header (nnheader-parse-nov)) + (forward-line 1) + (push (list (mail-header-number header) + header (mail-header-xref header)) + nnweb-articles) + (nnweb-set-hashtb header (car nnweb-articles)))))) (defun nnweb-write-overview (group) "Write the overview file for GROUP." @@ -386,8 +382,7 @@ Valid types include `google', `dejanews', and `gmane'.") (setq nnweb-articles (nconc nnweb-articles map)) (when (setq header (cadar map)) - (mm-with-unibyte-current-buffer - (mm-url-insert (mail-header-xref header))) + (mm-url-insert (mail-header-xref header)) (caar map)))) (defun nnweb-google-create-mapping () commit ce10b20710dcdf6952a8e6a8de1d054f17bdd883 Author: Lars Ingebrigtsen Date: Fri Feb 12 16:03:22 2016 +1100 Encode before sending from nnspool * lisp/gnus/nnspool.el (nnspool-request-post): Encode data before sending it to the news server. diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 620b8ac..07624f2 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -335,6 +335,7 @@ there.") (save-excursion (let* ((process-connection-type nil) ; t bugs out on Solaris (inews-buffer (generate-new-buffer " *nnspool post*")) + (buf (current-buffer)) (proc (condition-case err (apply 'start-process "*nnspool inews*" inews-buffer @@ -346,7 +347,11 @@ there.") () (nnheader-report 'nnspool "") (set-process-sentinel proc 'nnspool-inews-sentinel) - (mm-with-unibyte-current-buffer + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-buffer-substring buf) + (encode-coding-region (point-min) (point-max) + nnspool-file-coding-system) (process-send-region proc (point-min) (point-max))) ;; We slap a condition-case around this, because the process may ;; have exited already... commit 49d0595f1f09bdaec7f6eb5a6ef86014cecf6746 Author: Lars Ingebrigtsen Date: Fri Feb 12 15:59:38 2016 +1100 nnrss buffers don't have to be unibyte * lisp/gnus/nnrss.el (nnrss-insert): The buffer doesn't have to be unibyte just to receive data, I think. diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 0403f5d..6d2d16a 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -582,12 +582,11 @@ which RSS 2.0 allows." "") (defun nnrss-insert (url) - (mm-with-unibyte-current-buffer - (condition-case err - (mm-url-insert url) - (error (if (or debug-on-quit debug-on-error) - (signal (car err) (cdr err)) - (message "nnrss: Failed to fetch %s" url)))))) + (condition-case err + (mm-url-insert url) + (error (if (or debug-on-quit debug-on-error) + (signal (car err) (cdr err)) + (message "nnrss: Failed to fetch %s" url))))) (defun nnrss-decode-entities-string (string) (if string commit 2ffc32f50543fcd866b9dd97c28f964492835bb9 Author: Lars Ingebrigtsen Date: Fri Feb 12 15:57:13 2016 +1100 Don't use mm-with-unibyte-current-buffer in mml2015 * lisp/gnus/mml2015.el (mml2015-mailcrypt-encrypt): Don't use mm-with-unibyte-current-buffer. diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 60fdded..ca9b377 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -487,14 +487,17 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (or (y-or-n-p "Sign the message? ") 'not)))) 'never))) - (mm-with-unibyte-current-buffer - (mc-encrypt-generic - (or (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (mc-cleanup-recipient-headers - (read-string "Recipients: ")))) - nil nil nil - (message-options-get 'message-sender)))) + (insert + (with-temp-buffer + (set-buffer-multibyte nil) + (mc-encrypt-generic + (or (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (mc-cleanup-recipient-headers + (read-string "Recipients: ")))) + nil nil nil + (message-options-get 'message-sender)) + (buffer-string)))) (goto-char (point-min)) (unless (looking-at "-----BEGIN PGP MESSAGE-----") (error "Fail to encrypt the message")) commit a856a45292dda3123ffc6419735d43cefb126b85 Author: Lars Ingebrigtsen Date: Fri Feb 12 15:52:43 2016 +1100 Don't use mm-with-unibyte-current in mml1991 * lisp/gnus/mml1991.el (mml1991-epg-sign): Don't use mm-with-unibyte-current. diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 6db81be..140f720 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -283,17 +283,20 @@ Whether the passphrase is cached at all is controlled by (let* ((pair (mml-secure-epg-sign 'OpenPGP 'clear)) (signature (car pair))) (delete-region (point-min) (point-max)) - (mm-with-unibyte-current-buffer - (insert signature) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (when cte - (mm-encode-content-transfer-encoding cte)) - (goto-char (point-min)) - (when headers - (insert headers)) - (insert "\n")) + (insert + (with-temp-buffer + (set-buffer-multibyte nil) + (insert signature) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (when cte + (mm-encode-content-transfer-encoding cte)) + (goto-char (point-min)) + (when headers + (insert headers)) + (insert "\n") + (buffer-string))) t))) (defun mml1991-epg-encrypt (cont &optional sign) commit 7fe8d82924d92ea0d14861b74f8ce266e7bea52a Author: Lars Ingebrigtsen Date: Fri Feb 12 15:51:13 2016 +1100 Don't use mm-with-unibyte-current in mml1991 * lisp/gnus/mml1991.el (mml1991-pgg-sign): Don't use mm-with-unibyte-current. diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index bb5c940..6db81be 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -200,17 +200,20 @@ Whether the passphrase is cached at all is controlled by (pop-to-buffer pgg-errors-buffer) (error "Encrypt error")) (delete-region (point-min) (point-max)) - (mm-with-unibyte-current-buffer - (insert-buffer-substring pgg-output-buffer) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (when cte - (mm-encode-content-transfer-encoding cte)) - (goto-char (point-min)) - (when headers - (insert headers)) - (insert "\n")) + (insert + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-buffer-substring pgg-output-buffer) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (when cte + (mm-encode-content-transfer-encoding cte)) + (goto-char (point-min)) + (when headers + (insert headers)) + (insert "\n") + (buffer-string))) t)) (defun mml1991-pgg-encrypt (cont &optional sign) commit 4a3ea2323bb6eebb425c22f0a5de2c544cc1999b Author: Lars Ingebrigtsen Date: Fri Feb 12 15:48:49 2016 +1100 Don't use mm-with-unibyte-buffer in utf7 * lisp/gnus/utf7.el (utf7-fragment-encode): Don't use mm-with-unibyte-buffer. diff --git a/lisp/gnus/utf7.el b/lisp/gnus/utf7.el index 2168b7c..bd04eba 100644 --- a/lisp/gnus/utf7.el +++ b/lisp/gnus/utf7.el @@ -119,11 +119,17 @@ Use IMAP modification if FOR-IMAP is non-nil." "Encode text from START to END in buffer as UTF-7 escape fragment. Use IMAP modification if FOR-IMAP is non-nil." (save-restriction - (narrow-to-region start end) - (funcall (utf7-get-u16char-converter 'to-utf-16)) - (mm-with-unibyte-current-buffer - (base64-encode-region start (point-max))) - (goto-char start) + (let* ((buf (current-buffer)) + (base (with-temp-buffer + (set-buffer-multibyte nil) + (insert-buffer-substring buf start end) + (funcall (utf7-get-u16char-converter 'to-utf-16)) + (base64-encode-region (point-min) (point-max)) + (buffer-string)))) + (narrow-to-region start end) + (delete-region (point-min) (point-max)) + (insert base)) + (goto-char (point-min)) (let ((pm (point-max))) (when for-imap (while (search-forward "/" nil t) @@ -186,7 +192,6 @@ Use IMAP modification if FOR-IMAP is non-nil." "Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode. Characters are converted to raw byte pairs in narrowed buffer." (encode-coding-region (point-min) (point-max) 'iso-8859-1) - (mm-disable-multibyte) (goto-char (point-min)) (while (not (eobp)) (insert 0) commit 4f8de080ef9bd6417fa99560f8bf9f3e7cc4d28b Author: Lars Ingebrigtsen Date: Fri Feb 12 15:08:20 2016 +1100 Remove XEmacs compat code from Gnus helper libraries * lisp/gnus/plstore.el (plstore-called-interactively-p): Remove. * lisp/gnus/pop3.el (pop3-make-date): Remove XEmacs compat. * lisp/gnus/sieve-mode.el: Remove XEmacs compat. * lisp/gnus/spam-stat.el (spam-stat-called-interactively-p): Remove. diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el index e327bbd..5685590 100644 --- a/lisp/gnus/plstore.el +++ b/lisp/gnus/plstore.el @@ -554,18 +554,6 @@ If no one is selected, symmetric encryption will be performed. " (plstore-mode-original) (plstore-mode-decoded))) -(eval-when-compile - (defmacro plstore-called-interactively-p (kind) - (condition-case nil - (progn - (eval '(called-interactively-p 'any)) - ;; Emacs >=23.2 - `(called-interactively-p ,kind)) - ;; Emacs <23.2 - (wrong-number-of-arguments '(called-interactively-p)) - ;; XEmacs - (void-function '(interactive-p))))) - ;;;###autoload (define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE" "Major mode for editing PLSTORE files." @@ -573,7 +561,7 @@ If no one is selected, symmetric encryption will be performed. " (add-hook 'write-contents-functions #'plstore--write-contents-functions) (define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display) ;; to create a new file with plstore-mode, mark it as already decoded - (if (plstore-called-interactively-p 'any) + (if (called-interactively-p 'any) (setq plstore-encoded t) (plstore-mode-decoded))) diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index fc59380..41ebe98 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -644,9 +644,7 @@ If NOW, use that time instead." (format " %s " (capitalize (car (rassoc (nth 4 (decode-time now)) parse-time-months)))) - (format-time-string "%Y %H:%M:%S " now) - ;; We do all of this because XEmacs doesn't have the %z spec. - (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60))))) + (format-time-string "%Y %H:%M:%S %z" now)))) (defun pop3-munge-message-separator (start end) "Check to see if a message separator exists. If not, generate one." diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el index 81646b4..ee2af48 100644 --- a/lisp/gnus/rfc1843.el +++ b/lisp/gnus/rfc1843.el @@ -90,7 +90,6 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (while (re-search-forward (if rfc1843-decode-hzp rfc1843-hzp-word-regexp rfc1843-word-regexp) (point-max) t) - ;;; Text with extents may cause XEmacs crash (setq str (buffer-substring-no-properties (match-beginning 1) (match-end 1))) diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index be491e9..2862bb3 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -356,9 +356,7 @@ The buffer may be narrowed." ;; it appears to be the cleanest way. ;; Play safe and don't assume the form of the word syntax entry -- ;; copy it from ?a. - (if (featurep 'xemacs) - (put-char-table t (get-char-table ?a (standard-syntax-table)) table) - (set-char-table-range table t (aref (standard-syntax-table) ?a))) + (set-char-table-range table t (aref (standard-syntax-table) ?a)) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?\( "(" table) diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el index 5ea687d..7575ba6 100644 --- a/lisp/gnus/sieve-mode.el +++ b/lisp/gnus/sieve-mode.el @@ -204,9 +204,8 @@ Turning on Sieve mode runs `sieve-mode-hook'." (set (make-local-variable 'comment-end) "") ;;(set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *") (set (make-local-variable 'comment-start-skip) "#+ *") - (unless (featurep 'xemacs) - (set (make-local-variable 'font-lock-defaults) - '(sieve-font-lock-keywords nil nil ((?_ . "w"))))) + (set (make-local-variable 'font-lock-defaults) + '(sieve-font-lock-keywords nil nil ((?_ . "w")))) (easy-menu-add-item nil nil sieve-mode-menu)) ;; Menu diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index d1077a9..27e3127 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -588,13 +588,9 @@ A string or a list of strings is returned." "Get certificate for MAIL from the ldap server at HOST." (let ((ldapresult (funcall - (if (featurep 'xemacs) - (progn - (require 'smime-ldap) - 'smime-ldap-search) - (progn - (require 'ldap) - 'ldap-search)) + (progn + (require 'ldap) + 'ldap-search) (concat "mail=" mail) host '("userCertificate") nil)) (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index afcc541..23b4556 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -493,18 +493,6 @@ where DIFF is the difference between SCORE and 0.5." (setcdr (nthcdr 14 result) nil) result)) -(eval-when-compile - (defmacro spam-stat-called-interactively-p (kind) - (condition-case nil - (progn - (eval '(called-interactively-p 'any)) - ;; Emacs >=23.2 - `(called-interactively-p ,kind)) - ;; Emacs <23.2 - (wrong-number-of-arguments '(called-interactively-p)) - ;; XEmacs - (void-function '(interactive-p))))) - (defun spam-stat-score-buffer () "Return a score describing the spam-probability for this buffer. Add user supplied modifications if supplied." @@ -522,7 +510,7 @@ Add user supplied modifications if supplied." (error nil))) (ans (if score1s (+ score0 score1s) score0))) - (when (spam-stat-called-interactively-p 'any) + (when (called-interactively-p 'any) (message "%S" ans)) ans)) diff --git a/lisp/gnus/yenc.el b/lisp/gnus/yenc.el index cfac06d..a4ebd0d 100644 --- a/lisp/gnus/yenc.el +++ b/lisp/gnus/yenc.el @@ -90,8 +90,8 @@ (setq last (match-beginning 0)) (setq footer-alist (yenc-parse-line (match-string 0))) (setq work-buffer (generate-new-buffer " *yenc-work*")) - (unless (featurep 'xemacs) - (with-current-buffer work-buffer (set-buffer-multibyte nil))) + (with-current-buffer work-buffer + (set-buffer-multibyte nil)) (while (< first last) (setq char (char-after first)) (cond ((or (eq char ?\r) commit 9f7711815b808d69f74af93c5a7a36ae6a73900c Author: Lars Ingebrigtsen Date: Fri Feb 12 15:02:32 2016 +1100 Remove XEmacs compat code from Gnus backends * lisp/gnus/mm-view.el (mm-inline-image-xemacs): Remove. (mm-inline-image): Rename from mm-inline-image-emacs. * lisp/gnus/mml.el: Remove XEmacs compat code. * lisp/gnus/nnheader.el: Remove XEmacs compat code. * lisp/gnus/nnimap.el (nnimap-open-connection-1): Remove XEmacs compat code. * lisp/gnus/nnir.el (nnir-run-gmane): Remove XEmacs compat code. * lisp/gnus/nnmail.el (nnmail-pathname-coding-system): Remove XEmacs compat code. * lisp/gnus/nnmairix.el: Remove XEmacs compat code. * lisp/gnus/nnrss.el: Remove XEmacs compat code. * lisp/gnus/nntp.el: Remove XEmacs compat code. diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 2fa856c..b1ff318 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -249,14 +249,7 @@ To disable dissecting shar codes, for instance, add (defsubst mm-uu-function-2 (entry) (nth 5 entry)) -;; In Emacs 22, we could use `min-colors' in the face definition. But Emacs -;; 21 and XEmacs don't support it. -(defcustom mm-uu-hide-markers - (< 16 (or (and (fboundp 'defined-colors) - (length (defined-colors))) - (and (fboundp 'device-color-cells) - (device-color-cells)) - 0)) +(defcustom mm-uu-hide-markers (< 16 (length (defined-colors))) "If non-nil, hide verbatim markers. The value should be nil on displays where the face `mm-uu-extract' isn't distinguishable to the face `default'." @@ -299,10 +292,7 @@ apply the face `mm-uu-extract'." (let ((obuf (current-buffer)) (multi (and (boundp 'enable-multibyte-characters) enable-multibyte-characters)) - (coding-system - ;; Might not exist in non-MULE XEmacs - (when (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) + (coding-system buffer-file-coding-system)) (with-current-buffer (generate-new-buffer " *mm-uu*") (if multi (mm-enable-multibyte) (mm-disable-multibyte)) (setq buffer-file-coding-system coding-system) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index d8da137..ba77410 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -79,7 +79,7 @@ (autoload 'gnus-rescale-image "gnus-util") -(defun mm-inline-image-emacs (handle) +(defun mm-inline-image (handle) (let ((b (point-marker)) (inhibit-read-only t)) (put-image @@ -104,27 +104,6 @@ (remove-images b b) (delete-region b (1+ b))))))) -(defun mm-inline-image-xemacs (handle) - (when (featurep 'xemacs) - (insert "\n") - (forward-char -1) - (let ((annot (make-annotation (mm-get-image handle) nil 'text)) - (inhibit-read-only t)) - (mm-handle-set-undisplayer - handle - `(lambda () - (let ((b ,(point-marker)) - (inhibit-read-only t)) - (delete-annotation ,annot) - (delete-region (1- b) b)))) - (set-extent-property annot 'mm t) - (set-extent-property annot 'duplicable t)))) - -(eval-and-compile - (if (featurep 'xemacs) - (defalias 'mm-inline-image 'mm-inline-image-xemacs) - (defalias 'mm-inline-image 'mm-inline-image-emacs))) - (defvar mm-w3m-setup nil "Whether gnus-article-mode has been setup to use emacs-w3m.") @@ -462,11 +441,6 @@ handle `(lambda () (let ((inhibit-read-only t)) - (if (fboundp 'remove-specifier) - ;; This is only valid on XEmacs. - (dolist (prop '(background background-pixmap foreground)) - (remove-specifier - (face-property 'default prop) (current-buffer)))) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) ;; Shut up byte-compiler. @@ -526,14 +500,6 @@ If MODE is not set, try to find mode automatically." (if (fboundp 'font-lock-ensure) (font-lock-ensure) (font-lock-fontify-buffer))))) - ;; By default, XEmacs font-lock uses non-duplicable text - ;; properties. This code forces all the text properties - ;; to be copied along with the text. - (when (featurep 'xemacs) - (map-extents (lambda (ext ignored) - (set-extent-property ext 'duplicable t) - nil) - nil nil nil nil nil 'text-prop)) (setq text (buffer-string)) ;; Set buffer unmodified to avoid confirmation when killing the ;; buffer. @@ -542,9 +508,8 @@ If MODE is not set, try to find mode automatically." (mm-insert-inline handle text))) ;; Shouldn't these functions check whether the user even wants to use -;; font-lock? At least under XEmacs, this fontification is pretty -;; much unconditional. Also, it would be nice to change for the size -;; of the fontified region. +;; font-lock? Also, it would be nice to change for the size of the +;; fontified region. (defun mm-display-patch-inline (handle) (mm-display-inline-fontify handle 'diff-mode)) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index c4cb763..ce152ac 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -29,9 +29,6 @@ (require 'mml-sec) (eval-when-compile (require 'cl)) (eval-when-compile (require 'url)) -(eval-when-compile - (when (featurep 'xemacs) - (require 'easy-mmode))) ; for `define-minor-mode' (autoload 'message-make-message-id "message") (declare-function gnus-setup-posting-charset "gnus-msg" (group)) @@ -656,9 +653,7 @@ be \"related\" or \"alternate\"." filename))))) (t (let ((contents (cdr (assq 'contents cont)))) - (if (if (featurep 'xemacs) - (string-match "[^\000-\377]" contents) - (multibyte-string-p contents)) + (if (multibyte-string-p contents) (progn (mm-enable-multibyte) (insert contents) @@ -1107,57 +1102,42 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (easy-menu-define mml-menu mml-mode-map "" `("Attachments" - ["Attach File..." mml-attach-file - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach a file at point"))] + ["Attach File..." mml-attach-file :help "Attach a file at point"] ["Attach Buffer..." mml-attach-buffer - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach a buffer to the outgoing message"))] + :help "Attach a buffer to the outgoing message"] ["Attach External..." mml-attach-external - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach reference to an external file"))] + :help "Attach reference to an external file"] ;; FIXME: Is it possible to do this without using ;; `gnus-gcc-externalize-attachments'? ["Externalize Attachments" (lambda () (interactive) - (if (not (and (boundp 'gnus-gcc-externalize-attachments) - (memq gnus-gcc-externalize-attachments - '(all t nil)))) - ;; Stupid workaround for XEmacs not honoring :visible. - (message "Can't handle this value of `gnus-gcc-externalize-attachments'") - (setq gnus-gcc-externalize-attachments - (not gnus-gcc-externalize-attachments)) - (message "gnus-gcc-externalize-attachments is `%s'." - gnus-gcc-externalize-attachments))) - ;; XEmacs barfs on :visible. - ,@(if (featurep 'xemacs) nil - '(:visible (and (boundp 'gnus-gcc-externalize-attachments) - (memq gnus-gcc-externalize-attachments - '(all t nil))))) + (setq gnus-gcc-externalize-attachments + (not gnus-gcc-externalize-attachments)) + (message "gnus-gcc-externalize-attachments is `%s'." + gnus-gcc-externalize-attachments)) + :visible (and (boundp 'gnus-gcc-externalize-attachments) + (memq gnus-gcc-externalize-attachments + '(all t nil))) :style toggle :selected gnus-gcc-externalize-attachments - ,@(if (featurep 'xemacs) nil - '(:help "Save attachments as external parts in Gcc copies"))] + :help "Save attachments as external parts in Gcc copies"] "----" ;; ("Change Security Method" ["PGP/MIME" (lambda () (interactive) (setq mml-secure-method "pgpmime")) - ,@(if (featurep 'xemacs) nil - '(:help "Set Security Method to PGP/MIME")) + :help "Set Security Method to PGP/MIME" :style radio :selected (equal mml-secure-method "pgpmime") ] ["S/MIME" (lambda () (interactive) (setq mml-secure-method "smime")) - ,@(if (featurep 'xemacs) nil - '(:help "Set Security Method to S/MIME")) + :help "Set Security Method to S/MIME" :style radio :selected (equal mml-secure-method "smime") ] ["Inline PGP" (lambda () (interactive) (setq mml-secure-method "pgp")) - ,@(if (featurep 'xemacs) nil - '(:help "Set Security Method to inline PGP")) + :help "Set Security Method to inline PGP" :style radio :selected (equal mml-secure-method "pgp") ] ) ;; @@ -1165,8 +1145,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["Encrypt Message" mml-secure-message-encrypt t] ["Sign and Encrypt Message" mml-secure-message-sign-encrypt t] ["Encrypt/Sign off" mml-unsecure-message - ,@(if (featurep 'xemacs) '(t) - '(:help "Don't Encrypt/Sign Message"))] + :help "Don't Encrypt/Sign Message"] ;; Do we have separate encrypt and encrypt/sign commands for parts? ["Sign Part" mml-secure-sign t] ["Encrypt Part" mml-secure-encrypt t] @@ -1181,26 +1160,18 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ;;["Narrow" mml-narrow-to-part t] ["Quote MML in region" mml-quote-region :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Quote MML tags in region"))] + :help "Quote MML tags in region"] ["Validate MML" mml-validate t] ["Preview" mml-preview t] "----" ["Emacs MIME manual" (lambda () (interactive) (message-info 4)) - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the Emacs MIME manual"))] + :help "Display the Emacs MIME manual"] ["PGG manual" (lambda () (interactive) (message-info mml2015-use)) - ;; XEmacs barfs on :visible. - ,@(if (featurep 'xemacs) nil - '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'pgg)))) - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the PGG manual"))] + :visible (and (boundp 'mml2015-use) (equal mml2015-use 'pgg)) + :help "Display the PGG manual"] ["EasyPG manual" (lambda () (interactive) (require 'mml2015) (message-info mml2015-use)) - ;; XEmacs barfs on :visible. - ,@(if (featurep 'xemacs) nil - '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'epg)))) - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the EasyPG manual"))])) + :visible (and (boundp 'mml2015-use) (equal mml2015-use 'epg)) + :help "Display the EasyPG manual"])) (define-minor-mode mml-mode "Minor mode for editing MML. diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index c8c95f0..42dfcb3 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -726,9 +726,7 @@ the line could be found." (string-match nnheader-numerical-short-files file) (string-to-number (match-string 0 file)))) -(defvar nnheader-directory-files-is-safe - (or (eq system-type 'windows-nt) - (not (featurep 'xemacs))) +(defvar nnheader-directory-files-is-safe (not (eq system-type 'windows-nt)) "If non-nil, Gnus believes `directory-files' is safe. It has been reported numerous times that `directory-files' fails with an alarming frequency on NFS mounted file systems. If it is nil, @@ -780,28 +778,8 @@ If FULL, translate everything." 2 0)) ;; We translate -- but only the file name. We leave the directory ;; alone. - (if (and (featurep 'xemacs) - (memq system-type '(windows-nt cygwin))) - ;; This is needed on NT and stuff, because - ;; file-name-nondirectory is not enough to split - ;; file names, containing ':', e.g. - ;; "d:\\Work\\News\\nntp+news.fido7.ru:fido7.ru.gnu.SCORE" - ;; - ;; we are trying to correctly split such names: - ;; "d:file.name" -> "a:" "file.name" - ;; "aaa:bbb.ccc" -> "" "aaa:bbb.ccc" - ;; "d:aaa\\bbb:ccc" -> "d:aaa\\" "bbb:ccc" - ;; etc. - ;; to translate then only the file name part. - (progn - (setq leaf file - path "") - (if (string-match "\\(^\\w:\\|[/\\]\\)\\([^/\\]+\\)$" file) - (setq leaf (substring file (match-beginning 2)) - path (substring file 0 (match-beginning 2))))) - ;; Emacs DTRT, says andrewi. - (setq leaf (file-name-nondirectory file) - path (file-name-directory file)))) + (setq leaf (file-name-nondirectory file) + path (file-name-directory file))) (setq len (length leaf)) (while (< i len) (when (setq trans (cdr (assq (aref leaf i) @@ -1098,16 +1076,14 @@ See `find-file-noselect' for the arguments." (defmacro nnheader-insert-buffer-substring (buffer &optional start end) "Copy string from unibyte buffer to multibyte current buffer." - (if (featurep 'xemacs) - `(insert-buffer-substring ,buffer ,start ,end) - `(if enable-multibyte-characters - (insert (with-current-buffer ,buffer - (string-to-multibyte - ,(if (or start end) - `(buffer-substring (or ,start (point-min)) - (or ,end (point-max))) - '(buffer-string))))) - (insert-buffer-substring ,buffer ,start ,end)))) + `(if enable-multibyte-characters + (insert (with-current-buffer ,buffer + (string-to-multibyte + ,(if (or start end) + `(buffer-substring (or ,start (point-min)) + (or ,end (point-max))) + '(buffer-string))))) + (insert-buffer-substring ,buffer ,start ,end))) (defvar nnheader-last-message-time '(0 0)) (defun nnheader-message-maybe (&rest args) @@ -1116,9 +1092,6 @@ See `find-file-noselect' for the arguments." (setq nnheader-last-message-time now) (apply 'nnheader-message args)))) -(when (featurep 'xemacs) - (require 'nnheaderxm)) - (run-hooks 'nnheader-load-hook) (provide 'nnheader) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 7ad7b7e..8921a9c 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -447,9 +447,7 @@ textual parts.") (when (and stream (not (memq (process-status stream) '(open run)))) (setq stream nil)) - (when (and (fboundp 'set-network-process-option) ;; Not in XEmacs. - (fboundp 'process-type) ;; Emacs 22 doesn't provide it. - (eq (process-type stream) 'network)) + (when (eq (process-type stream) 'network) ;; Use TCP-keepalive so that connections that pass through a NAT ;; router don't hang when left idle. (set-network-process-option stream :keepalive t)) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 09fd7b3..a36dba4 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1688,7 +1688,7 @@ actually)." (mm-url-encode-www-form-urlencoded `(("query" . ,search) ("HITSPERPAGE" . "999"))))) - (unless (featurep 'xemacs) (set-buffer-multibyte t)) + (set-buffer-multibyte t) (decode-coding-region (point-min) (point-max) 'utf-8) (goto-char (point-min)) (forward-line 1) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 625b417..ae322b7 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -628,14 +628,7 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." mm-text-coding-system "Coding system used in reading inbox") -(defvar nnmail-pathname-coding-system - ;; This causes Emacs 22.2 and 22.3 to issue a useless warning. - ;;(if (and (featurep 'xemacs) (featurep 'file-coding)) - (if (featurep 'xemacs) - (if (featurep 'file-coding) - ;; Work around a bug in many XEmacs 21.5 betas. - ;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/68134 - (setq file-name-coding-system (coding-system-aliasee 'file-name)))) +(defvar nnmail-pathname-coding-system nil "*Coding system for file name.") (defun nnmail-find-file (file) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 20aecd9..128f912 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -147,11 +147,6 @@ ;;; === Keymaps -(eval-when-compile - (when (featurep 'xemacs) - ;; The `kbd' macro requires that the `read-kbd-macro' macro is available. - (require 'edmacro))) - ;; Group mode (defun nnmairix-group-mode-hook () "Nnmairix group mode keymap." diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 57c3af0..0403f5d 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -240,7 +240,6 @@ for decoding when the cdr that the data specify is not available.") (max 1 (/ (* (window-width window) 7) 8)))) (fill-region (point) (point-max)) (goto-char (point-max)) - ;; XEmacs version of `fill-region' inserts newline. (unless (bolp) (insert "\n")))) (when (or link enclosure) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index d339cb2..6108b5a 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -244,8 +244,7 @@ server there that you can connect to. See also (defvoo nntp-connection-timeout nil "*Number of seconds to wait before an nntp connection times out. -If this variable is nil, which is the default, no timers are set. -NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.") +If this variable is nil, which is the default, no timers are set.") (defvoo nntp-prepare-post-hook nil "*Hook run just before posting an article. It is supposed to be used @@ -344,16 +343,14 @@ retried once before actually displaying the error report." (defmacro nntp-copy-to-buffer (buffer start end) "Copy string from unibyte current buffer to multibyte buffer." - (if (featurep 'xemacs) - `(copy-to-buffer ,buffer ,start ,end) - `(let ((string (buffer-substring ,start ,end))) - (with-current-buffer ,buffer - (erase-buffer) - (insert (if enable-multibyte-characters - (string-to-multibyte string) - string)) - (goto-char (point-min)) - nil)))) + `(let ((string (buffer-substring ,start ,end))) + (with-current-buffer ,buffer + (erase-buffer) + (insert (if enable-multibyte-characters + (string-to-multibyte string) + string)) + (goto-char (point-min)) + nil))) (defsubst nntp-wait-for (process wait-for buffer &optional decode discard) "Wait for WAIT-FOR to arrive from PROCESS." @@ -1301,9 +1298,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (nntp-kill-buffer pbuffer)) (when (and (buffer-name pbuffer) process) - (when (and (fboundp 'set-network-process-option) ;; Unavailable in XEmacs. - (fboundp 'process-type) ;; Emacs 22 doesn't provide it. - (eq (process-type process) 'network)) + (when (eq (process-type process) 'network) ;; Use TCP-keepalive so that connections that pass through a NAT router ;; don't hang when left idle. (set-network-process-option process :keepalive t)) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 347a91d..7552396 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -513,7 +513,7 @@ Valid types include `google', `dejanews', and `gmane'.") ;;("TOPDOC" . "1000") )))) (setq buffer-file-name nil) - (unless (featurep 'xemacs) (set-buffer-multibyte t)) + (set-buffer-multibyte t) (decode-coding-region (point-min) (point-max) 'utf-8) t) commit 37cf4454b1646481935e7b5bfffc8f64eb484b3a Author: Lars Ingebrigtsen Date: Fri Feb 12 14:39:30 2016 +1100 Remove XEmacs compat functions from mm-util.el * lisp/gnus/mm-util.el (mm-special-display-p): Remove. (mm-decode-coding-string, mm-encode-coding-string) (mm-decode-coding-region, mm-encode-coding-region): Remove. (mm-string-to-multibyte): Remove. (mm-char-or-char-int-p): Remove. (mm-ucs-to-char): Remove compat versions of the function. (mm-read-coding-system): Remove. (mm-coding-system-p): Remove compat code. (mm-enrich-utf-8-by-mule-ucs): Remove. (mm-enable-multibyte, mm-disable-multibyte): Remove compat versions. (mm-delete-duplicates): Remove. (mm-multibyte-p): Remove compat versions. (mm-xemacs-find-mime-charset-1): Remove. (mm-xemacs-find-mime-charset): Remove. (mm-make-temp-file): Made obsolete. (mm-find-buffer-file-coding-system): Remove XEmacs compat. diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index da3d670..32b39b9 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -1601,9 +1601,9 @@ authentication tokens: (list k (plist-get spec k)))) search-keys)))) ;; needed keys (always including host, login, port, and secret) - (returned-keys (mm-delete-duplicates (append - '(:host :login :port :secret) - search-keys))) + (returned-keys (delete-dups (append + '(:host :login :port :secret) + search-keys))) (items (loop for search-spec in search-specs nconc @@ -1730,9 +1730,9 @@ entries for git.gnus.org: (list k (plist-get spec k)))) search-keys))) ;; needed keys (always including host, login, port, and secret) - (returned-keys (mm-delete-duplicates (append - '(:host :login :port :secret) - search-keys))) + (returned-keys (delete-dups (append + '(:host :login :port :secret) + search-keys))) ;; Extract host and port from spec (hosts (plist-get spec :host)) (hosts (if (and hosts (listp hosts)) hosts `(,hosts))) @@ -1872,9 +1872,9 @@ entries for git.gnus.org: (list k v)))) search-keys))) ;; needed keys (always including host, login, port, and secret) - (returned-keys (mm-delete-duplicates (append - '(:host :login :port :secret) - search-keys))) + (returned-keys (delete-dups (append + '(:host :login :port :secret) + search-keys))) (items (plstore-find store search-spec)) (item-names (mapcar #'car items)) (items (butlast items (- (length items) max))) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 99d107e..68d07c7 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2508,7 +2508,7 @@ If PROMPT (the prefix), prompt for a coding system to use." ctl (and ct (mail-header-parse-content-type ct)) charset (cond (prompt - (mm-read-coding-system "Charset to decode: ")) + (read-coding-system "Charset to decode: ")) (ctl (mail-content-type-get ctl 'charset))) format (and ctl (mail-content-type-get ctl 'format))) @@ -2629,7 +2629,7 @@ If READ-CHARSET, ask for a coding system." (if (stringp charset) (setq charset (intern (downcase charset))))))) (if read-charset - (setq charset (mm-read-coding-system "Charset: " charset))) + (setq charset (read-coding-system "Charset: " charset))) (unless charset (setq charset gnus-newsgroup-charset)) (when (or force @@ -2657,7 +2657,7 @@ If READ-CHARSET, ask for a coding system." (if (stringp charset) (setq charset (intern (downcase charset))))))) (if read-charset - (setq charset (mm-read-coding-system "Charset: " charset))) + (setq charset (read-coding-system "Charset: " charset))) (unless charset (setq charset gnus-newsgroup-charset)) (when (or force @@ -2667,7 +2667,7 @@ If READ-CHARSET, ask for a coding system." (save-restriction (narrow-to-region (point) (point-max)) (base64-decode-region (point-min) (point-max)) - (mm-decode-coding-region + (decode-coding-region (point-min) (point-max) (mm-charset-to-coding-system charset nil t))))))) @@ -2850,7 +2850,7 @@ message header will be added to the bodies of the \"text/html\" parts." ]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\"" nil t) (unless cid-dir - (setq cid-dir (mm-make-temp-file "cid" t)) + (setq cid-dir (make-temp-file "cid" t)) (add-to-list 'gnus-article-browse-html-temp-list cid-dir)) (setq file nil content nil) @@ -2863,7 +2863,7 @@ message header will be added to the bodies of the \"text/html\" parts." (replace-match cid-file nil nil nil 1)))) (unless content (setq content (buffer-string)))) (when (or charset header (not file)) - (setq tmp-file (mm-make-temp-file + (setq tmp-file (make-temp-file ;; Do we need to care for 8.3 filenames? "mm-" nil ".html"))) ;; Add a meta html tag to specify charset and a header. @@ -2897,11 +2897,11 @@ message header will be added to the bodies of the \"text/html\" parts." ;; charset specified in parts might be different. (if (eq charset 'gnus-decoded) (setq charset 'utf-8 - eheader (mm-encode-coding-string (buffer-string) - charset) + eheader (encode-coding-string (buffer-string) + charset) title (when title - (mm-encode-coding-string title charset)) - body (mm-encode-coding-string content charset)) + (encode-coding-string title charset)) + body (encode-coding-string content charset)) (setq hcharset (mm-find-mime-charset-region (point-min) (point-max))) (cond ((= (length hcharset) 1) @@ -2918,30 +2918,30 @@ message header will be added to the bodies of the \"text/html\" parts." (mm-charset-to-coding-system charset nil t)) (if (eq coding body) - (setq eheader (mm-encode-coding-string + (setq eheader (encode-coding-string (buffer-string) coding) title (when title - (mm-encode-coding-string + (encode-coding-string title coding)) body content) (setq charset 'utf-8 - eheader (mm-encode-coding-string + eheader (encode-coding-string (buffer-string) charset) title (when title - (mm-encode-coding-string + (encode-coding-string title charset)) - body (mm-encode-coding-string - (mm-decode-coding-string + body (encode-coding-string + (decode-coding-string content body) charset)))) (setq charset hcharset - eheader (mm-encode-coding-string + eheader (encode-coding-string (buffer-string) coding) title (when title - (mm-encode-coding-string + (encode-coding-string title coding)) body content)) - (setq eheader (mm-string-as-unibyte (buffer-string)) + (setq eheader (string-as-unibyte (buffer-string)) body content))) (erase-buffer) (mm-disable-multibyte) @@ -2964,8 +2964,8 @@ message header will be added to the bodies of the \"text/html\" parts." (charset (mm-with-unibyte-buffer (insert (if (eq charset 'gnus-decoded) - (mm-encode-coding-string content - (setq charset 'utf-8)) + (encode-coding-string content + (setq charset 'utf-8)) content)) (if (or (mm-add-meta-html-tag handle charset) (not file)) @@ -5253,7 +5253,7 @@ are decompressed." ((numberp arg) (setq charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: "))))) + (read-coding-system "Charset: "))))) (switch-to-buffer (generate-new-buffer filename)) (if (or coding-system (and charset @@ -5262,7 +5262,7 @@ are decompressed." (not (eq coding-system 'ascii)))) (progn (mm-enable-multibyte) - (insert (mm-decode-coding-string contents coding-system)) + (insert (decode-coding-string contents coding-system)) (setq buffer-file-coding-system (if (boundp 'last-coding-system-used) (symbol-value 'last-coding-system-used) @@ -5284,7 +5284,7 @@ are decompressed." (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (and handle (mm-get-part handle))) - (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory))) + (file (make-temp-file (expand-file-name "mm." mm-tmp-directory))) (printer (mailcap-mime-info (mm-handle-media-type handle) "print"))) (when contents (if printer @@ -5425,7 +5425,7 @@ specified charset." (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: ")))) + (read-coding-system "Charset: ")))) (if (mm-handle-undisplayer handle) (mm-remove-part handle))) (gnus-mime-set-charset-parameters handle charset) @@ -7060,7 +7060,7 @@ If given a prefix, show the hidden text instead." ;; equivalent of string-make-multibyte which amount to decoding ;; with locale-coding-system, causing failure of ;; subsequent decoding. - (insert (mm-string-to-multibyte + (insert (string-to-multibyte (with-current-buffer gnus-original-article-buffer (buffer-substring (point-min) (point-max))))) 'article) @@ -8280,7 +8280,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-button-handle-info-url (url) "Fetch an info URL." - (setq url (mm-subst-char-in-string ?+ ?\ url)) + (setq url (subst-char-in-string ?+ ?\ url)) (cond ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url) (gnus-info-find-node @@ -8296,7 +8296,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-button-handle-info-url-gnome (url) "Fetch GNOME style info URL." - (setq url (mm-subst-char-in-string ?_ ?\ url)) + (setq url (subst-char-in-string ?_ ?\ url)) (if (string-match "\\([^#]+\\)#?\\(.*\\)" url) (gnus-info-find-node (concat "(" diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 83ccc4f..fa320e0 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -458,8 +458,8 @@ system for example was used.") (and (boundp 'default-file-name-coding-system) default-file-name-coding-system)))) (push (cons group decoded) gnus-cache-decoded-group-names) - (push (cons (mm-decode-coding-string - (mm-encode-coding-string decoded coding) + (push (cons (decode-coding-string + (encode-coding-string decoded coding) coding) group) gnus-cache-unified-group-names) diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index de66e34..669de2b 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -416,7 +416,7 @@ category.")) ;; Decode values posting-style holds. (dolist (style (cdr (assq 'posting-style values))) (when (stringp (cadr style)) - (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8))))) + (setcdr style (list (decode-coding-string (cadr style) 'utf-8))))) (setq gnus-custom-params (apply 'widget-create 'group @@ -492,7 +492,7 @@ form, but who cares?" ;; Encode values posting-style holds. (dolist (style (cdr (assq 'posting-style params))) (when (stringp (cadr style)) - (setcdr style (list (mm-encode-coding-string (cadr style) 'utf-8))))) + (setcdr style (list (encode-coding-string (cadr style) 'utf-8))))) (if gnus-custom-topic (gnus-topic-set-parameters gnus-custom-topic params) (gnus-group-edit-group-done 'params gnus-custom-group params) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index eec7b1c..18dd281 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1145,7 +1145,7 @@ The following commands are available: (goto-char (point-min)) (setq gnus-group-mark-positions (list (cons 'process (and (search-forward - (mm-string-to-multibyte "\200") nil t) + (string-to-multibyte "\200") nil t) (- (point) (point-min) 1)))))))) (defun gnus-mouse-pick-group (e) @@ -1208,7 +1208,7 @@ The following commands are available: (defun gnus-group-name-decode (string charset) ;; Fixme: Don't decode in unibyte mode. (if (and string charset (featurep 'mule)) - (mm-decode-coding-string string charset) + (decode-coding-string string charset) string)) (defun gnus-group-decoded-name (string) @@ -2216,7 +2216,7 @@ if it is not a list." (member group (mapcar 'symbol-name collection)) (symbol-value (intern-soft group collection))) (setq group - (mm-encode-coding-string + (encode-coding-string group (gnus-group-name-charset nil group)))) (replace-regexp-in-string group "\n" ""))) @@ -2378,7 +2378,7 @@ specified by `gnus-gmane-group-download-format'." (unless range (setq range 500)) (when (< range 1) (error "Invalid range: %s" range)) - (let ((tmpfile (mm-make-temp-file + (let ((tmpfile (make-temp-file (format "%s.start-%s.range-%s." group start range))) (gnus-thread-sort-functions '(gnus-thread-sort-by-number))) (with-temp-file tmpfile @@ -2464,7 +2464,7 @@ the bug number, and browsing the URL must return mbox output." (setq ids (string-to-number ids))) (unless (listp ids) (setq ids (list ids))) - (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) + (let ((tmpfile (make-temp-file "gnus-temp-group-"))) (let ((coding-system-for-write 'binary) (coding-system-for-read 'binary)) (with-temp-file tmpfile @@ -2738,7 +2738,7 @@ server." (when (stringp method) (setq method (or (gnus-server-to-method method) method))) (unless encoded - (setq name (mm-encode-coding-string + (setq name (encode-coding-string name (gnus-group-name-charset method name)))) (let* ((meth (gnus-method-simplify @@ -2856,7 +2856,7 @@ and NEW-NAME will be prompted for." "Rename group to: " (gnus-group-real-name (gnus-group-decoded-name group))) method (gnus-info-method (gnus-get-info group))) - (list group (mm-encode-coding-string + (list group (encode-coding-string new-name (gnus-group-name-charset method @@ -3070,9 +3070,9 @@ If called with a prefix argument, ask for the file type." (list 'nndoc-address file) (list 'nndoc-article-type (or type 'guess)))) (coding (gnus-group-name-charset method name))) - (setcar (cdr method) (mm-encode-coding-string file coding)) + (setcar (cdr method) (encode-coding-string file coding)) (gnus-group-make-group - (mm-encode-coding-string (gnus-group-real-name name) coding) + (encode-coding-string (gnus-group-real-name name) coding) method nil nil t))) (defvar nnweb-type-definition) @@ -3149,8 +3149,8 @@ If there is, use Gnus to create an nnrss group" (coding (gnus-group-name-charset '(nnrss "") title))) (when coding ;; Unify non-ASCII text. - (setq title (mm-decode-coding-string - (mm-encode-coding-string title coding) + (setq title (decode-coding-string + (encode-coding-string title coding) coding))) (gnus-group-make-group title '(nnrss "")) (push (list title href desc) nnrss-group-alist) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index f427610..f3b5b96 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -143,7 +143,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")." charset nil t)) (not (eq charset 'ascii))) (insert (prog1 - (mm-decode-coding-string (buffer-string) charset) + (decode-coding-string (buffer-string) charset) (erase-buffer) (mm-enable-multibyte)))) (call-process-region (point-min) (point-max) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index d277c0f..1cf372a 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -746,8 +746,7 @@ These will be used to retrieve the RSVP information from ical events." (with-temp-buffer (mm-insert-part ,handle) (when (string= ,charset "utf-8") - (mm-decode-coding-region (point-min) (point-max) 'utf-8)) - + (decode-coding-region (point-min) (point-max) 'utf-8)) ,@body)))) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 527735f..dec0e4e 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1342,7 +1342,7 @@ For the \"inline\" alternatives, also see the variable (gnus-inews-insert-gcc) (let ((gcc (mapcar (lambda (group) - (mm-encode-coding-string + (encode-coding-string group (gnus-group-name-charset (gnus-inews-group-method group) group))) @@ -1359,7 +1359,7 @@ For the \"inline\" alternatives, also see the variable (insert "Gcc: \"" gnus-newsgroup-name "\"\n")) ((stringp self) (insert "Gcc: " - (mm-encode-coding-string + (encode-coding-string (if (string-match " " self) (concat "\"" self "\"") self) @@ -1398,7 +1398,7 @@ For the \"inline\" alternatives, also see the variable tem) (dolist (style styles) (when (stringp (cadr style)) - (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8))))) + (setcdr style (list (decode-coding-string (cadr style) 'utf-8))))) (dolist (style (if styles (append gnus-posting-styles (list (cons ".*" styles))) gnus-posting-styles)) @@ -1637,7 +1637,7 @@ this is a reply." ;; Copy the article over to some group(s). (while (setq group (pop groups)) (setq method (gnus-inews-group-method group) - group (mm-encode-coding-string + group (encode-coding-string group (gnus-group-name-charset method group))) (unless (gnus-check-server method) @@ -1840,8 +1840,8 @@ this is a reply." (when tmp-style (dolist (style tmp-style) (when (stringp (cadr style)) - (setcdr style (list (mm-decode-coding-string (cadr style) - 'utf-8))))) + (setcdr style (list (decode-coding-string (cadr style) + 'utf-8))))) (setq styles (append styles (list (cons ".*" tmp-style))))))) ;; Go through all styles and look for matches. (dolist (style styles) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index a53cabd..bb807da 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -802,7 +802,7 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (mm-string-as-unibyte + (string-as-unibyte (buffer-substring (point) (progn @@ -815,7 +815,7 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (mm-string-as-unibyte + (string-as-unibyte (if (eq (char-after) ?\") (read cur) (let ((p (point)) (name "")) @@ -883,7 +883,7 @@ claim them." (if (and (fboundp 'detect-coding-string) (eq (detect-coding-string name t) 'undecided)) name - (mm-decode-coding-string + (decode-coding-string name (inline (gnus-group-name-charset method name))))))) (list 'gnus-group name) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 825c95c..b081a66 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1992,7 +1992,7 @@ backend check whether the group actually exists." (while lists (setq killed (car lists)) (while killed - (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb) + (gnus-sethash (string-as-unibyte (car killed)) nil hashtb) (setq killed (cdr killed))) (setq lists (cdr lists))))) @@ -2455,7 +2455,7 @@ If FORCE is non-nil, the .newsrc file is read." (dolist (elem gnus-newsrc-alist) ;; Protect against broken .newsrc.el files. (when (car elem) - (setcar elem (mm-string-as-unibyte (car elem))))) + (setcar elem (string-as-unibyte (car elem))))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file @@ -3160,7 +3160,7 @@ If FORCE is non-nil, the .newsrc file is read." gnus-default-charset))) ;; Fixme: Don't decode in unibyte mode. (when (and str charset (featurep 'mule)) - (setq str (mm-decode-coding-string str charset))) + (setq str (decode-coding-string str charset))) (set group str))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 683eca1..dfdf8e1 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4446,9 +4446,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defsubst gnus-remove-odd-characters (string) "Translate STRING into something that doesn't contain weird characters." - (mm-subst-char-in-string + (subst-char-in-string ?\r ?\- - (mm-subst-char-in-string ?\n ?\- string t) t)) + (subst-char-in-string ?\n ?\- string t) t)) ;; This function has to be called with point after the article number ;; on the beginning of the line. @@ -5578,15 +5578,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-kill-buffer (current-buffer))) (error "Couldn't activate group %s: %s" - (mm-decode-coding-string group charset) - (mm-decode-coding-string (gnus-status-message group) charset)))) + (decode-coding-string group charset) + (decode-coding-string (gnus-status-message group) charset)))) (unless (gnus-request-group group t nil (gnus-get-info group)) (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" - (mm-decode-coding-string group charset) - (mm-decode-coding-string (gnus-status-message group) charset))) + (decode-coding-string group charset) + (decode-coding-string (gnus-status-message group) charset))) (when (and gnus-agent (gnus-active group)) @@ -9653,7 +9653,7 @@ C-u g', show the raw article." (gnus-summary-show-article t) (let ((gnus-newsgroup-charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system + (read-coding-system "View as charset: " ;; actually it is coding system. (with-current-buffer gnus-article-buffer (mm-detect-coding-region (point) (point-max)))))) @@ -9948,7 +9948,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." encoded to-newsgroup to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) (set (intern (format "gnus-current-%s-group" action)) - (mm-decode-coding-string + (decode-coding-string to-newsgroup (gnus-group-name-charset to-method to-newsgroup)))) (unless to-method @@ -9958,7 +9958,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (setq to-newsgroup (or encoded (and to-newsgroup - (mm-encode-coding-string + (encode-coding-string to-newsgroup (gnus-group-name-charset to-method to-newsgroup))))) ;; Check the method we are to move this article to... @@ -11135,7 +11135,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (goto-char (+ forward (point))) ;; Replace the old mark with the new mark. (let ((to-insert - (mm-subst-char-in-string + (subst-char-in-string (char-after) mark (buffer-substring (point) (1+ (point)))))) (delete-region (point) (1+ (point))) @@ -12279,7 +12279,7 @@ save those articles instead." (setq to-newsgroup default)) (unless to-newsgroup (error "No group name entered")) - (setq encoded (mm-encode-coding-string + (setq encoded (encode-coding-string to-newsgroup (gnus-group-name-charset to-method to-newsgroup))) (or (gnus-active encoded) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 1a249e9..6a0c8f9 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -408,7 +408,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." gnus-uu-default-dir)))) (gnus-uu-initialize) (setq gnus-uu-binhex-article-name - (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) + (make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) (defun gnus-uu-decode-yenc (n dir) @@ -474,7 +474,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." gnus-uu-default-dir gnus-uu-default-dir))) (gnus-uu-initialize) (setq gnus-uu-binhex-article-name - (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) + (make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-binhex n file))) @@ -486,7 +486,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive "P") (gnus-uu-initialize) (let ((gnus-uu-save-in-digest t) - (file (mm-make-temp-file (nnheader-concat gnus-uu-work-dir "forward"))) + (file (make-temp-file (nnheader-concat gnus-uu-work-dir "forward"))) (message-forward-as-mime message-forward-as-mime) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) @@ -1784,7 +1784,7 @@ Gnus might fail to display all of it.") gnus-uu-tmp-dir))) (setq gnus-uu-work-dir - (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) + (make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) (gnus-set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (push (cons gnus-newsgroup-name gnus-uu-work-dir) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index fe86749..04496b6 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3234,8 +3234,7 @@ If ARG, insert string at point." 4.99 (+ 5 (* 0.02 (abs - (- (mm-char-int (aref (downcase alpha) 0)) - (mm-char-int ?t)))) + (- (aref (downcase alpha) 0) ?t))) -0.01)) minor least) (format "%d.%02d%02d" major minor least)))))) diff --git a/lisp/gnus/ietf-drums.el b/lisp/gnus/ietf-drums.el index 429eead..d833366 100644 --- a/lisp/gnus/ietf-drums.el +++ b/lisp/gnus/ietf-drums.el @@ -81,10 +81,10 @@ backslash and doublequote.") (let ((i 0) b e c out range) (while (< i (length token)) - (setq c (mm-char-int (aref token i))) + (setq c (aref token i)) (incf i) (cond - ((eq c (mm-char-int ?-)) + ((eq c ?-) (if b (setq range t) (push c out))) diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index 62d8b9b..7ceb865 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -32,13 +32,6 @@ (eval-when-compile (require 'cl)) (autoload 'mail-header-parse-content-type "mail-parse") -;; `mm-delete-duplicates' is an alias for `delete-dups' in Emacs 22. -(defalias 'mailcap-delete-duplicates - (if (fboundp 'delete-dups) - 'delete-dups - (autoload 'mm-delete-duplicates "mm-util") - 'mm-delete-duplicates)) - (defgroup mailcap nil "Definition of viewers for MIME types." :version "21.1" diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index b56c5cd..dec4c37 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2167,7 +2167,7 @@ contains a valid encoded word. Decode again? " ;; No double encoded subject? => bogus charset. (unless cs-coding (setq cs-coding - (mm-read-coding-system + (read-coding-system (format-message "\ Decoded Subject \"%s\" contains an encoded word. The charset `%s' is unknown or invalid. @@ -4319,7 +4319,7 @@ conformance." (point) 'no-illegible-text) (point-max)))) (setq char (char-after))) - (when (or (< (mm-char-int char) 128) + (when (or (< char 128) (and (mm-multibyte-p) (memq (char-charset char) '(eight-bit-control eight-bit-graphic @@ -4349,7 +4349,7 @@ conformance." (skip-chars-forward mm-7bit-chars) (while (not (eobp)) (when (let ((char (char-after))) - (or (< (mm-char-int char) 128) + (or (< char 128) (and (mm-multibyte-p) ;; FIXME: Wrong for Emacs 23 (unicode) and for ;; things like undecodable utf-8 (in Emacs 21?). @@ -5346,7 +5346,7 @@ Otherwise, generate and save a value for `canlock-password' first." ;; Check for control characters. (message-check 'control-chars (if (re-search-forward - (mm-string-to-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]") + (string-to-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]") nil t) (y-or-n-p "The article contains control characters. Really post? ") @@ -5895,7 +5895,7 @@ subscribed address (and not the additional To and Cc header contents)." ace) (when field (dolist (rhs - (mm-delete-duplicates + (delete-dups (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) "")) (mapcar 'downcase (mapcar @@ -7427,7 +7427,7 @@ Optional DIGEST will use digest to forward." (let ((b (point)) (contents (with-current-buffer forward-buffer (buffer-string))) e) - (unless (mm-multibyte-string-p contents) + (unless (multibyte-string-p contents) (error "Attempt to insert unibyte string from the buffer \"%s\"\ to the multibyte buffer \"%s\"" (if (bufferp forward-buffer) @@ -7490,7 +7490,7 @@ Optional DIGEST will use digest to forward." (let ((b (point)) e) (if (not message-forward-decoded-p) (let ((contents (with-current-buffer forward-buffer (buffer-string)))) - (unless (mm-multibyte-string-p contents) + (unless (multibyte-string-p contents) (error "Attempt to insert unibyte string from the buffer \"%s\"\ to the multibyte buffer \"%s\"" (if (bufferp forward-buffer) diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el index 45dbd90..bac722e 100644 --- a/lisp/gnus/mm-archive.el +++ b/lisp/gnus/mm-archive.el @@ -37,7 +37,7 @@ (defun mm-dissect-archive (handle) (let ((decoder (cddr (assoc (car (mm-handle-type handle)) mm-archive-decoders))) - (dir (mm-make-temp-file + (dir (make-temp-file (expand-file-name "emm." mm-tmp-directory) 'dir))) (set-file-modes dir #o700) (unwind-protect diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index cd57695..e07edd3 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -86,15 +86,15 @@ If no encoding was done, nil is returned." (message-options-get 'mm-body-charset-encoding-alist) (message-options-set 'mm-body-charset-encoding-alist - (mm-read-coding-system "Charset used in the article: "))) + (read-coding-system "Charset used in the article: "))) ;; The logic in `mml-generate-mime-1' confirms that it's OK ;; to return nil here. nil))) (save-excursion (if charset (progn - (mm-encode-coding-region (point-min) (point-max) - (mm-charset-to-coding-system charset)) + (encode-coding-region (point-min) (point-max) + (mm-charset-to-coding-system charset)) charset) (goto-char (point-min)) (let ((charsets (mm-find-mime-charset-region (point-min) (point-max) @@ -110,8 +110,8 @@ If no encoding was done, nil is returned." (t (prog1 (setq charset (car charsets)) - (mm-encode-coding-region (point-min) (point-max) - (mm-charset-to-coding-system charset)))) + (encode-coding-region (point-min) (point-max) + (mm-charset-to-coding-system charset)))) )))))) (defun mm-long-lines-p (length) @@ -258,8 +258,7 @@ decoding. If it is nil, default to `mail-parse-charset'." (mm-multibyte-p) (or (not (eq coding-system 'ascii)) (setq coding-system mail-parse-charset))) - (mm-decode-coding-region (point-min) (point-max) - coding-system)) + (decode-coding-region (point-min) (point-max) coding-system)) (setq buffer-file-coding-system (if (boundp 'last-coding-system-used) (symbol-value 'last-coding-system-used) @@ -290,7 +289,7 @@ decoding. If it is nil, default to `mail-parse-charset'." (mm-multibyte-p) (or (not (eq coding-system 'ascii)) (setq coding-system mail-parse-charset))) - (mm-decode-coding-string string coding-system)))) + (decode-coding-string string coding-system)))) string)) (provide 'mm-bodies) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index d1240c0..d690014 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -773,7 +773,7 @@ MIME-Version header before proceeding." (with-current-buffer (generate-new-buffer " *mm*") ;; Preserve the data's unibyteness (for url-insert-file-contents). - (mm-set-buffer-multibyte mb) + (set-buffer-multibyte mb) (insert-buffer-substring obuf beg) (current-buffer)))) @@ -888,7 +888,7 @@ external if displayed external." (select-window win))) (switch-to-buffer (generate-new-buffer " *mm*"))) (buffer-disable-undo) - (mm-set-buffer-file-coding-system mm-binary-coding-system) + (set-buffer-file-coding-system mm-binary-coding-system) (insert-buffer-substring cur) (goto-char (point-min)) (when method @@ -1307,7 +1307,7 @@ are ignored." (with-current-buffer (mm-handle-buffer handle) (buffer-string))) ((mm-multibyte-p) - (mm-string-to-multibyte (mm-get-part handle no-cache))) + (string-to-multibyte (mm-get-part handle no-cache))) (t (mm-get-part handle no-cache))))) (save-restriction @@ -1813,7 +1813,7 @@ If RECURSIVE, search recursively." (mm-charset-to-coding-system charset nil t)) (not (eq charset 'ascii))) - (mm-decode-coding-string (buffer-string) charset) + (decode-coding-string (buffer-string) charset) (mm-string-as-multibyte (buffer-string))) (erase-buffer) (mm-enable-multibyte))) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index e5c43fd..25954b9 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -364,7 +364,7 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (string-to-number (substring entity 1))))) (setq c (or (cdr (assq c mm-extra-numeric-entities)) (mm-ucs-to-char c))) - (if (mm-char-or-char-int-p c) c ?#)) + (if (char-valid-p c) c ?#)) (or (cdr (assq (intern entity) mm-url-html-entities)) ?#)))) @@ -399,10 +399,10 @@ spaces. Die Die Die." ((= char ? ) "+") ((memq char mm-url-unreserved-chars) (char-to-string char)) (t (upcase (format "%%%02x" char))))) - (mm-encode-coding-string chunk - (if (fboundp 'find-coding-systems-string) - (car (find-coding-systems-string chunk)) - buffer-file-coding-system)) + (encode-coding-string chunk + (if (fboundp 'find-coding-systems-string) + (car (find-coding-systems-string chunk)) + buffer-file-coding-system)) ""))) (defun mm-url-encode-www-form-urlencoded (pairs) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 9deca23..97b28bc 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -44,50 +44,7 @@ (if (fboundp (car elem)) (defalias nfunc (car elem)) (defalias nfunc (cdr elem))))) - `(;; `coding-system-list' is not available in XEmacs 21.4 built - ;; without the `file-coding' feature. - (coding-system-list . ignore) - ;; `char-int' is an XEmacs function, not available in Emacs. - (char-int . identity) - ;; `coding-system-equal' is an Emacs function, not available in XEmacs. - (coding-system-equal . equal) - ;; `set-buffer-file-coding-system' is not available in XEmacs 21.4 - ;; built without the `file-coding' feature. - (set-buffer-file-coding-system . ignore) - ;; `read-charset' is an Emacs function, not available in XEmacs. - (read-charset - . ,(lambda (prompt) - "Return a charset." - (intern - (gnus-completing-read - prompt - (mapcar (lambda (e) (symbol-name (car e))) - mm-mime-mule-charset-alist) - t)))) - ;; `subst-char-in-string' is not available in XEmacs 21.4. - (subst-char-in-string - . ,(lambda (from to string &optional inplace) - ;; stolen (and renamed) from nnheader.el - "Replace characters in STRING from FROM to TO. - Unless optional argument INPLACE is non-nil, return a new string." - (let ((string (if inplace string (copy-sequence string))) - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string))) - ;; `replace-in-string' is an XEmacs function, not available in Emacs. - (replace-in-string - . ,(lambda (string regexp rep &optional literal) - "See `replace-regexp-in-string', only the order of args differs." - (replace-regexp-in-string regexp rep string nil literal))) - ;; `string-as-unibyte' is an Emacs function, not available in XEmacs. - (string-as-unibyte . identity) - ;; `string-make-unibyte' is an Emacs function, not available in XEmacs. - (string-make-unibyte . identity) + `( ;; string-as-multibyte often doesn't really do what you think it does. ;; Example: ;; (aref (string-as-multibyte "\201") 0) -> 129 (aka ?\201) @@ -107,189 +64,22 @@ ;; (string-to-multibyte s) ~= (decode-coding-string s 'binary) ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system) ;; `string-as-multibyte' is an Emacs function, not available in XEmacs. - (string-as-multibyte . identity) - ;; `multibyte-string-p' is an Emacs function, not available in XEmacs. - (multibyte-string-p . ignore) - ;; `insert-byte' is available only in Emacs 23.1 or greater. - (insert-byte . insert-char) - ;; `multibyte-char-to-unibyte' is an Emacs function, not available - ;; in XEmacs. - (multibyte-char-to-unibyte . identity) - ;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs. - (set-buffer-multibyte . ignore) - ;; `substring-no-properties' is available only in Emacs 22.1 or greater. - (substring-no-properties - . ,(lambda (string &optional from to) - "Return a substring of STRING, without text properties. -It starts at index FROM and ending before TO. -TO may be nil or omitted; then the substring runs to the end of STRING. -If FROM is nil or omitted, the substring starts at the beginning of STRING. -If FROM or TO is negative, it counts from the end. - -With one argument, just copy STRING without its properties." - (setq string (substring string (or from 0) to)) - (set-text-properties 0 (length string) nil string) - string)) - ;; `line-number-at-pos' is available only in Emacs 22.1 or greater - ;; and XEmacs 21.5. - (line-number-at-pos - . ,(lambda (&optional pos) - "Return (narrowed) buffer line number at position POS. -If POS is nil, use current buffer location. -Counting starts at (point-min), so the value refers -to the contents of the accessible portion of the buffer." - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point)))))))))) - -;; `special-display-p' is an Emacs function, not available in XEmacs. -(defalias 'mm-special-display-p - (if (featurep 'emacs) - 'special-display-p - (lambda (buffer-name) - "Returns non-nil if a buffer named BUFFER-NAME gets a special frame." - (and special-display-function - (or (and (member buffer-name special-display-buffer-names) t) - (cdr (assoc buffer-name special-display-buffer-names)) - (catch 'return - (dolist (elem special-display-regexps) - (and (stringp elem) - (string-match elem buffer-name) - (throw 'return t)) - (and (consp elem) - (stringp (car elem)) - (string-match (car elem) buffer-name) - (throw 'return (cdr elem)))))))))) - -;; `decode-coding-string', `encode-coding-string', `decode-coding-region' -;; and `encode-coding-region' are available in Emacs and XEmacs built with -;; the `file-coding' feature, but the XEmacs versions treat nil, that is -;; given as the `coding-system' argument, as the `binary' coding system. -(eval-and-compile - (if (featurep 'xemacs) - (if (featurep 'file-coding) - (progn - (defun mm-decode-coding-string (str coding-system) - (if coding-system - (decode-coding-string str coding-system) - str)) - (defun mm-encode-coding-string (str coding-system) - (if coding-system - (encode-coding-string str coding-system) - str)) - (defun mm-decode-coding-region (start end coding-system) - (if coding-system - (decode-coding-region start end coding-system))) - (defun mm-encode-coding-region (start end coding-system) - (if coding-system - (encode-coding-region start end coding-system)))) - (defun mm-decode-coding-string (str coding-system) str) - (defun mm-encode-coding-string (str coding-system) str) - (defalias 'mm-decode-coding-region 'ignore) - (defalias 'mm-encode-coding-region 'ignore)) - (defalias 'mm-decode-coding-string 'decode-coding-string) - (defalias 'mm-encode-coding-string 'encode-coding-string) - (defalias 'mm-decode-coding-region 'decode-coding-region) - (defalias 'mm-encode-coding-region 'encode-coding-region))) - -;; `string-to-multibyte' is available only in Emacs. -(defalias 'mm-string-to-multibyte (if (featurep 'xemacs) - 'identity - 'string-to-multibyte)) - -;; `char-or-char-int-p' is an XEmacs function, not available in Emacs. -(eval-and-compile - (defalias 'mm-char-or-char-int-p - (cond - ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) - ((fboundp 'char-valid-p) 'char-valid-p) - (t 'identity)))) + (string-as-multibyte . identity)))) -;; `ucs-to-char' is a function that Mule-UCS provides. -(eval-and-compile - (if (featurep 'xemacs) - (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5. - (subrp (symbol-function 'unicode-to-char))) - (if (featurep 'mule) - (defalias 'mm-ucs-to-char 'unicode-to-char) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (or (unicode-to-char codepoint) ?#)))) - ((featurep 'mule) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded. - (progn - (defalias 'mm-ucs-to-char - (lambda (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (ucs-to-char codepoint) ?#) - (error ?#)))) - (mm-ucs-to-char codepoint)) - (condition-case nil - (or (int-to-char codepoint) ?#) - (error ?#))))) - (t - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (int-to-char codepoint) ?#) - (error ?#))))) - (if (let ((char (make-char 'japanese-jisx0208 36 34))) - (eq char (decode-char 'ucs char))) - ;; Emacs 23. - (defalias 'mm-ucs-to-char 'identity) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (or (decode-char 'ucs codepoint) ?#))))) - -;; Fixme: This seems always to be used to read a MIME charset, so it -;; should be re-named and fixed (in Emacs) to offer completion only on -;; proper charset names (base coding systems which have a -;; mime-charset defined). XEmacs doesn't believe in mime-charset; -;; test with -;; `(or (coding-system-get 'iso-8859-1 'mime-charset) -;; (coding-system-get 'iso-8859-1 :mime-charset))' -;; Actually, there should be an `mm-coding-system-mime-charset'. -(eval-and-compile - (defalias 'mm-read-coding-system - (if (featurep 'emacs) 'read-coding-system - (cond - ((fboundp 'read-coding-system) - (if (and (featurep 'xemacs) - (<= (string-to-number emacs-version) 21.1)) - (lambda (prompt &optional default-coding-system) - (read-coding-system prompt)) - 'read-coding-system)) - (t (lambda (prompt &optional default-coding-system) - "Prompt the user for a coding system." - (gnus-completing-read - prompt (mapcar (lambda (s) (symbol-name (car s))) - mm-mime-mule-charset-alist)))))))) +(defun mm-ucs-to-char (codepoint) + "Convert Unicode codepoint to character." + (or (decode-char 'ucs codepoint) ?#)) (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () "Get the coding system list." (or mm-coding-system-list - (setq mm-coding-system-list (mm-coding-system-list)))) + (setq mm-coding-system-list (coding-system-list)))) (defun mm-coding-system-p (cs) - "Return non-nil if CS is a symbol naming a coding system. -In XEmacs, also return non-nil if CS is a coding system object. -If CS is available, return CS itself in Emacs, and return a coding -system object in XEmacs." - (if (fboundp 'find-coding-system) - (and cs (find-coding-system cs)) - (if (fboundp 'coding-system-p) - (when (coding-system-p cs) - cs) - ;; no-MULE XEmacs: - (car (memq cs (mm-get-coding-system-list)))))) + "Return CS if CS is a coding system." + (and (coding-system-p cs) + cs)) (defvar mm-charset-synonym-alist `( @@ -478,14 +268,13 @@ Unless LIST is given, `mm-codepage-ibm-list' is used." ;; Note: this has to be defined before `mm-charset-to-coding-system'. (defcustom mm-charset-eval-alist - (if (featurep 'xemacs) - nil ;; I don't know what would be useful for XEmacs. - '(;; Emacs 22 provides autoloads for 1250-1258 - ;; (i.e. `mm-codepage-setup' does nothing). - (windows-1250 . (mm-codepage-setup 1250 t)) - (windows-1251 . (mm-codepage-setup 1251 t)) - (windows-1253 . (mm-codepage-setup 1253 t)) - (windows-1257 . (mm-codepage-setup 1257 t)))) + '( + ;; Emacs 22 provides autoloads for 1250-1258 + ;; (i.e. `mm-codepage-setup' does nothing). + (windows-1250 . (mm-codepage-setup 1250 t)) + (windows-1251 . (mm-codepage-setup 1251 t)) + (windows-1253 . (mm-codepage-setup 1253 t)) + (windows-1257 . (mm-codepage-setup 1257 t))) "An alist of (CHARSET . FORM) pairs. If an article is encoded in an unknown CHARSET, FORM is evaluated. This allows the loading of additional libraries @@ -761,43 +550,21 @@ superset of iso-8859-1." (coding-system-get 'mule-utf-8 'safe-charsets)))))) "Alist of MIME-charset/MULE-charsets.") -(defun mm-enrich-utf-8-by-mule-ucs () - "Make the `utf-8' MIME charset usable by the Mule-UCS package. -This function will run when the `un-define' module is loaded under -XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' -with Mule charsets. It is completely useless for Emacs." - (when (boundp 'unicode-basic-translation-charset-order-list) - (condition-case nil - (let ((val (delq - 'ascii - (copy-sequence - (symbol-value - 'unicode-basic-translation-charset-order-list)))) - (elem (assq 'utf-8 mm-mime-mule-charset-alist))) - (if elem - (setcdr elem val) - (setq mm-mime-mule-charset-alist - (nconc mm-mime-mule-charset-alist - (list (cons 'utf-8 val)))))) - (error)))) - ;; Correct by construction, but should be unnecessary for Emacs: -(if (featurep 'xemacs) - (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs)) - (when (and (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (let ((css (sort-coding-systems (coding-system-list 'base-only))) - cs mime mule alist) - (while css - (setq cs (pop css) - mime (or (coding-system-get cs :mime-charset); Emacs 23 (unicode) - (coding-system-get cs 'mime-charset))) - (when (and mime - (not (eq t (setq mule - (coding-system-get cs 'safe-charsets)))) - (not (assq mime alist))) - (push (cons mime (delq 'ascii mule)) alist))) - (setq mm-mime-mule-charset-alist (nreverse alist))))) +(when (and (fboundp 'coding-system-list) + (fboundp 'sort-coding-systems)) + (let ((css (sort-coding-systems (coding-system-list 'base-only))) + cs mime mule alist) + (while css + (setq cs (pop css) + mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode) + (coding-system-get cs 'mime-charset))) + (when (and mime + (not (eq t (setq mule + (coding-system-get cs 'safe-charsets)))) + (not (assq mime alist))) + (push (cons mime (delq 'ascii mule)) alist))) + (setq mm-mime-mule-charset-alist (nreverse alist)))) (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) "A list of special charsets. @@ -903,21 +670,15 @@ like \"€\" to the euro sign, mainly in html messages.") (pop alist)) out))) -(eval-and-compile - (if (featurep 'xemacs) - (defalias 'mm-enable-multibyte 'ignore) - (defun mm-enable-multibyte () - "Set the multibyte flag of the current buffer. +(defun mm-enable-multibyte () + "Set the multibyte flag of the current buffer. Only do this if the default value of `enable-multibyte-characters' is -non-nil. This is a no-op in XEmacs." - (set-buffer-multibyte 'to))) +non-nil." + (set-buffer-multibyte 'to)) - (if (featurep 'xemacs) - (defalias 'mm-disable-multibyte 'ignore) - (defun mm-disable-multibyte () - "Unset the multibyte flag of in the current buffer. -This is a no-op in XEmacs." - (set-buffer-multibyte nil)))) +(defun mm-disable-multibyte () + "Unset the multibyte flag of in the current buffer." + (set-buffer-multibyte nil)) (defun mm-preferred-coding-system (charset) ;; A typo in some Emacs versions. @@ -951,7 +712,7 @@ If POS is nil, it defaults to the current point. If POS is out of range, the value is nil. If the charset is `composition', return the actual one." (let ((char (char-after pos)) charset) - (if (< (mm-char-int char) 128) + (if (< char 128) (setq charset 'ascii) ;; charset-after is fake in some Emacsen. (setq charset (and (fboundp 'char-charset) (char-charset char))) @@ -981,40 +742,11 @@ If the charset is `composition', return the actual one." ;; This is for XEmacs. (mm-mule-charset-to-mime-charset charset))) -;; `delete-dups' is not available in XEmacs 21.4. -(if (fboundp 'delete-dups) - (defalias 'mm-delete-duplicates 'delete-dups) - (defun mm-delete-duplicates (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept. - -This is a compatibility function for Emacsen without `delete-dups'." - ;; Code from `subr.el' in Emacs 22: - (let ((tail list)) - (while tail - (setcdr tail (delete (car tail) (cdr tail))) - (setq tail (cdr tail)))) - list)) - ;; Fixme: This is used in places when it should be testing the -;; default multibyteness. See mm-default-multibyte-p. -(eval-and-compile - (if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters)) - (defun mm-multibyte-p () - "Non-nil if multibyte is enabled in the current buffer." - enable-multibyte-characters) - (defun mm-multibyte-p () (featurep 'mule)))) - -(defun mm-default-multibyte-p () - "Return non-nil if the session is multibyte. -This affects whether coding conversion should be attempted generally." - (if (featurep 'mule) - (if (boundp 'enable-multibyte-characters) - (default-value 'enable-multibyte-characters) - t))) +;; default multibyteness. +(defun mm-multibyte-p () + "Non-nil if multibyte is enabled in the current buffer." + enable-multibyte-characters) (defun mm-iso-8859-x-to-15-region (&optional b e) (if (fboundp 'char-charset) @@ -1050,85 +782,6 @@ This affects whether coding conversion should be attempted generally." (length (memq (coding-system-base b) priorities))) t)))) -(declare-function latin-unity-massage-name "ext:latin-unity") -(declare-function latin-unity-maybe-remap "ext:latin-unity") -(declare-function latin-unity-representations-feasible-region "ext:latin-unity") -(declare-function latin-unity-representations-present-region "ext:latin-unity") - -(defvar latin-unity-coding-systems) -(defvar latin-unity-ucs-list) - -(defun mm-xemacs-find-mime-charset-1 (begin end) - "Determine which MIME charset to use to send region as message. -This uses the XEmacs-specific latin-unity package to better handle the -case where identical characters from diverse ISO-8859-? character sets -can be encoded using a single one of the corresponding coding systems. - -It treats `mm-coding-system-priorities' as the list of preferred -coding systems; a useful example setting for this list in Western -Europe would be (iso-8859-1 iso-8859-15 utf-8), which would default -to the very standard Latin 1 coding system, and only move to coding -systems that are less supported as is necessary to encode the -characters that exist in the buffer. - -Latin Unity doesn't know about those non-ASCII Roman characters that -are available in various East Asian character sets. As such, its -behavior if you have a JIS 0212 LATIN SMALL LETTER A WITH ACUTE in a -buffer and it can otherwise be encoded as Latin 1, won't be ideal. -But this is very much a corner case, so don't worry about it." - (let ((systems mm-coding-system-priorities) csets psets curset) - - ;; Load the Latin Unity library, if available. - (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) - (require 'latin-unity)) - - ;; Now, can we use it? - (if (featurep 'latin-unity) - (progn - (setq csets (latin-unity-representations-feasible-region begin end) - psets (latin-unity-representations-present-region begin end)) - - (catch 'done - - ;; Pass back the first coding system in the preferred list - ;; that can encode the whole region. - (dolist (curset systems) - (setq curset (latin-unity-massage-name 'buffer-default curset)) - - ;; If the coding system is a universal coding system, then - ;; it can certainly encode all the characters in the region. - (if (memq curset latin-unity-ucs-list) - (throw 'done (list curset))) - - ;; If a coding system isn't universal, and isn't in - ;; the list that latin unity knows about, we can't - ;; decide whether to use it here. Leave that until later - ;; in `mm-find-mime-charset-region' function, whence we - ;; have been called. - (unless (memq curset latin-unity-coding-systems) - (throw 'done nil)) - - ;; Right, we know about this coding system, and it may - ;; conceivably be able to encode all the characters in - ;; the region. - (if (latin-unity-maybe-remap begin end curset csets psets t) - (throw 'done (list curset)))) - - ;; Can't encode using anything from the - ;; `mm-coding-system-priorities' list. - ;; Leave `mm-find-mime-charset' to do most of the work. - nil)) - - ;; Right, latin unity isn't available; let `mm-find-charset-region' - ;; take its default action, which equally applies to GNU Emacs. - nil))) - -(defmacro mm-xemacs-find-mime-charset (begin end) - (when (featurep 'xemacs) - `(and (featurep 'mule) (mm-xemacs-find-mime-charset-1 ,begin ,end)))) - -(declare-function mm-delete-duplicates "mm-util" (list)) - (defun mm-find-mime-charset-region (b e &optional hack-charsets) "Return the MIME charsets needed to encode the region between B and E. nil means ASCII, a single-element list represents an appropriate MIME @@ -1170,16 +823,9 @@ charset, and a longer list means no appropriate charset." (setq systems nil charsets (list cs)))))) charsets)) - ;; If we're XEmacs, and some coding system is appropriate, - ;; mm-xemacs-find-mime-charset will return an appropriate list. - ;; Otherwise, we'll get nil, and the next setq will get invoked. - (setq charsets (mm-xemacs-find-mime-charset b e)) - - ;; Fixme: won't work for unibyte Emacs 23: - ;; We're not multibyte, or a single coding system won't cover it. (setq charsets - (mm-delete-duplicates + (delete-dups (mapcar 'mm-mime-charset (delq 'ascii (mm-find-charset-region b e)))))) @@ -1192,17 +838,6 @@ charset, and a longer list means no appropriate charset." (if (and (memq 'iso-2022-jp-2 charsets) (memq 'iso-2022-jp-2 hack-charsets)) (setq charsets (delq 'iso-2022-jp charsets))) - ;; Attempt to reduce the number of charsets if utf-8 is available. - (if (and (featurep 'xemacs) - (> (length charsets) 1) - (mm-coding-system-p 'utf-8)) - (let ((mm-coding-system-priorities - (cons 'utf-8 mm-coding-system-priorities))) - (setq charsets - (mm-delete-duplicates - (mapcar 'mm-mime-charset - (delq 'ascii - (mm-find-charset-region b e))))))) charsets)) (defmacro mm-with-unibyte-buffer (&rest forms) @@ -1225,7 +860,6 @@ Use multibyte mode for this." (defmacro mm-with-unibyte-current-buffer (&rest forms) "Evaluate FORMS with current buffer temporarily made unibyte. -Equivalent to `progn' in XEmacs. Note: We recommend not using this macro any more; there should be better ways to do a similar thing. The previous version of this macro @@ -1233,16 +867,14 @@ bound the default value of `enable-multibyte-characters' to nil while evaluating FORMS but it is no longer done. So, some programs assuming it if any may malfunction." (declare (obsolete nil "25.1") (indent 0) (debug t)) - (if (featurep 'xemacs) - `(progn ,@forms) - (let ((multibyte (make-symbol "multibyte"))) - `(let ((,multibyte enable-multibyte-characters)) + (let ((multibyte (make-symbol "multibyte"))) + `(let ((,multibyte enable-multibyte-characters)) + (when ,multibyte + (set-buffer-multibyte nil)) + (prog1 + (progn ,@forms) (when ,multibyte - (set-buffer-multibyte nil)) - (prog1 - (progn ,@forms) - (when ,multibyte - (set-buffer-multibyte t))))))) + (set-buffer-multibyte t)))))) (defun mm-find-charset-region (b e) "Return a list of Emacs charsets in the region B to E." @@ -1257,7 +889,7 @@ it if any may malfunction." css) (setq css (delq cs css))))) (t - ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit. + ;; We are in a unibyte buffer, so we futz around a bit. (save-excursion (save-restriction (narrow-to-region b e) @@ -1363,64 +995,8 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." inhibit-file-name-handlers))) (write-region start end filename append visit lockname))) -;; It is not a MIME function, but some MIME functions use it. -(if (and (fboundp 'make-temp-file) - (ignore-errors - (let ((def (if (fboundp 'compiled-function-arglist) ;; XEmacs - (eval (list 'compiled-function-arglist - (symbol-function 'make-temp-file))) - (require 'help-fns) - (help-function-arglist 'make-temp-file t)))) - (and (>= (length def) 4) - (eq (nth 3 def) 'suffix))))) - (defalias 'mm-make-temp-file 'make-temp-file) - ;; Stolen (and modified for XEmacs) from Emacs 22. - (defun mm-make-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file. -The returned file name (created by appending some random characters at the end -of PREFIX, and expanding against `temporary-file-directory' if necessary), -is guaranteed to point to a newly created empty file. -You can then use `write-region' to write new data into the file. - -If DIR-FLAG is non-nil, create a new empty directory instead of a file. - -If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes 448) - (while (condition-case err - (progn - (setq file - (make-temp-name - (expand-file-name - prefix - (if (fboundp 'temp-directory) - ;; XEmacs - (temp-directory) - temporary-file-directory)))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - (write-region "" nil file nil 'silent nil 'excl)) - nil) - (file-already-exists t) - ;; The XEmacs version of `make-directory' issues - ;; `file-error'. - (file-error (or (and (featurep 'xemacs) - (file-exists-p file)) - (signal (car err) (cdr err))))) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file) - ;; Reset the umask. - (set-default-file-modes umask))))) +(defalias 'mm-make-temp-file 'make-temp-file) +(define-obsolete-function-alias 'mm-make-temp-file 'make-temp-file "25.2") (defvar mm-image-load-path-cache nil) @@ -1469,26 +1045,11 @@ If SUFFIX is non-nil, add that at the end of the file name." (let ((cs (mm-detect-coding-region start end))) cs))) -(eval-when-compile - (unless (fboundp 'coding-system-to-mime-charset) - (defalias 'coding-system-to-mime-charset 'ignore))) - (defun mm-coding-system-to-mime-charset (coding-system) - "Return the MIME charset corresponding to CODING-SYSTEM. -To make this function work with XEmacs, the APEL package is required." + "Return the MIME charset corresponding to CODING-SYSTEM." (when coding-system - (or (and (fboundp 'coding-system-get) - (or (coding-system-get coding-system :mime-charset) - (coding-system-get coding-system 'mime-charset))) - (and (featurep 'xemacs) - (or (and (fboundp 'coding-system-to-mime-charset) - (not (eq (symbol-function 'coding-system-to-mime-charset) - 'ignore))) - (and (condition-case nil - (require 'mcharset) - (error nil)) - (fboundp 'coding-system-to-mime-charset))) - (coding-system-to-mime-charset coding-system))))) + (or (coding-system-get coding-system :mime-charset) + (coding-system-get coding-system 'mime-charset)))) (defvar jka-compr-acceptable-retval-list) (declare-function jka-compr-make-temp-name "jka-compr" (&optional local)) @@ -1587,66 +1148,16 @@ gzip, bzip2, etc. are allowed." (setq filename (file-name-sans-extension filename))) (goto-char (point-min)) (unwind-protect - (cond - ((boundp 'set-auto-coding-function) ;; Emacs - (if filename - (or (funcall (symbol-value 'set-auto-coding-function) - filename (- (point-max) (point-min))) - (car (find-operation-coding-system 'insert-file-contents - filename))) - (let (auto-coding-alist) - (condition-case nil - (funcall (symbol-value 'set-auto-coding-function) - nil (- (point-max) (point-min))) - (error nil))))) - ((and (featurep 'xemacs) (featurep 'file-coding)) ;; XEmacs - (let ((case-fold-search t) - (end (point-at-eol)) - codesys start) - (or - (and (re-search-forward "-\\*-+[\t ]*" end t) - (progn - (setq start (match-end 0)) - (re-search-forward "[\t ]*-+\\*-" end t)) - (progn - (setq end (match-beginning 0)) - (goto-char start) - (or (looking-at "coding:[\t ]*\\([^\t ;]+\\)") - (re-search-forward - "[\t ;]+coding:[\t ]*\\([^\t ;]+\\)" - end t))) - (find-coding-system (setq codesys - (intern (match-string 1)))) - codesys) - (and (re-search-forward "^[\t ]*;+[\t ]*Local[\t ]+Variables:" - nil t) - (progn - (setq start (match-end 0)) - (re-search-forward "^[\t ]*;+[\t ]*End:" nil t)) - (progn - (setq end (match-beginning 0)) - (goto-char start) - (re-search-forward - "^[\t ]*;+[\t ]*coding:[\t ]*\\([^\t\n\r ]+\\)" - end t)) - (find-coding-system (setq codesys - (intern (match-string 1)))) - codesys) - (and (progn - (goto-char (point-min)) - (setq case-fold-search nil) - (re-search-forward "^;;;coding system: " - ;;(+ (point-min) 3000) t)) - nil t)) - (looking-at "[^\t\n\r ]+") - (find-coding-system - (setq codesys (intern (match-string 0)))) - codesys) - (and filename - (setq codesys - (find-file-coding-system-for-read-from-filename - filename)) - (coding-system-name (coding-system-base codesys))))))) + (if filename + (or (funcall (symbol-value 'set-auto-coding-function) + filename (- (point-max) (point-min))) + (car (find-operation-coding-system 'insert-file-contents + filename))) + (let (auto-coding-alist) + (condition-case nil + (funcall (symbol-value 'set-auto-coding-function) + nil (- (point-max) (point-min))) + (error nil)))) (when decomp (kill-buffer (current-buffer))))))) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index a5b06b2..2fa856c 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -587,11 +587,11 @@ apply the face `mm-uu-extract'." (not (eq charset 'ascii))) ;; Assume that buffer's multibyteness is turned off. ;; See `mml2015-pgg-clear-decrypt'. - (insert (mm-decode-coding-string (prog1 - (buffer-string) - (erase-buffer) - (mm-enable-multibyte)) - charset)) + (insert (decode-coding-string (prog1 + (buffer-string) + (erase-buffer) + (mm-enable-multibyte)) + charset)) (mm-enable-multibyte)) (list (mm-make-handle buf mm-uu-text-plain-type))) (list (mm-make-handle buf '("application/pgp-encrypted"))))))) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index ed16313..d8da137 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -230,7 +230,7 @@ ((condition-case nil (let ((coding-system-for-write 'iso-2022-jp) (coding-system-for-read 'iso-2022-jp) - (str (mm-decode-coding-string "\ + (str (decode-coding-string "\ \e$B#D#o#e#s!!#w#3#m!!#s#u#p#p#o#r#t!!#m#1#7#n!)\e(B" 'iso-2022-jp))) (mm-with-multibyte-buffer (insert str) @@ -282,7 +282,7 @@ (delete-region (match-beginning 0) (match-end 0)))) (defun mm-inline-wash-with-file (post-func cmd &rest args) - (let ((file (mm-make-temp-file + (let ((file (make-temp-file (expand-file-name "mm" mm-tmp-directory)))) (let ((coding-system-for-write 'binary)) (write-region (point-min) (point-max) file nil 'silent)) @@ -496,7 +496,7 @@ If MODE is not set, try to find mode automatically." (with-current-buffer (mm-handle-buffer handle) (buffer-string))) (coding-system - (mm-decode-coding-string text coding-system)) + (decode-coding-string text coding-system)) (charset (mm-decode-string text charset)) (t diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 3ac3da0..5bfed9f 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -947,8 +947,9 @@ If no one is selected, symmetric encryption will be performed. " (if (eq 'OpenPGP protocol) (epg-sign-string context (buffer-string) mode) (epg-sign-string context - (mm-replace-in-string (buffer-string) - "\n" "\r\n") t)) + (replace-regexp-in-string (buffer-string) + "\n" "\r\n") + t)) mml-secure-secret-key-id-list nil) (error (mml-secure-clear-secret-key-id-list) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 407963f..02be62e 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -425,7 +425,7 @@ Content-Disposition: attachment; filename=smime.p7m (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) - (setq part (mm-replace-in-string part "\n" "\r\n") + (setq part (replace-regexp-in-string part "\n" "\r\n") context (epg-make-context 'CMS)) (condition-case error (setq plain (epg-verify-string context (mm-get-part signature) part)) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index ac84fbf..c4cb763 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -643,7 +643,7 @@ be \"related\" or \"alternate\"." (mm-with-unibyte-buffer (cond ((cdr (assq 'buffer cont)) - (insert (mm-string-as-unibyte + (insert (string-as-unibyte (with-current-buffer (cdr (assq 'buffer cont)) (buffer-string))))) ((and filename @@ -658,7 +658,7 @@ be \"related\" or \"alternate\"." (let ((contents (cdr (assq 'contents cont)))) (if (if (featurep 'xemacs) (string-match "[^\000-\377]" contents) - (mm-multibyte-string-p contents)) + (multibyte-string-p contents)) (progn (mm-enable-multibyte) (insert contents) @@ -1377,7 +1377,7 @@ body) or \"attachment\" (separate from the body)." 'type type ;; icicles redefines read-file-name and returns a ;; string w/ text properties :-/ - 'filename (mm-substring-no-properties file) + 'filename (substring-no-properties file) 'disposition (or disposition "attachment") 'description description) ;; When using Mail mode, make sure it does the mime encoding @@ -1606,7 +1606,7 @@ or the `pop-to-buffer' function." ;; FIXME: Buffer is in article mode, but most tool bar commands won't ;; work. Maybe only keep the following icons: search, print, quit (goto-char (point-min)))) - (if (and (not (mm-special-display-p (buffer-name mml-preview-buffer))) + (if (and (not (special-display-p (buffer-name mml-preview-buffer))) (boundp 'gnus-buffer-configuration) (assq 'mml-preview gnus-buffer-configuration)) (let ((gnus-message-buffer (current-buffer))) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 0125ddb..60fdded 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -619,7 +619,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (insert "\r")) (forward-line) (end-of-line)) - (with-temp-file (setq signature-file (mm-make-temp-file "pgg")) + (with-temp-file (setq signature-file (make-temp-file "pgg")) (mm-insert-part signature)) (if (condition-case err (prog1 @@ -660,7 +660,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (if (condition-case err (prog1 (mm-with-unibyte-buffer - (insert (mm-encode-coding-string text coding-system)) + (insert (encode-coding-string text coding-system)) (pgg-verify-region (point-min) (point-max) nil t)) (goto-char (point-min)) (while (search-forward "\r\n" nil t) @@ -783,7 +783,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defun mml2015-epg-key-image (key-id) "Return the image of a key, if any" (with-temp-buffer - (mm-set-buffer-multibyte nil) + (set-buffer-multibyte nil) (let* ((coding-system-for-write 'binary) (coding-system-for-read 'binary) (data (shell-command-to-string @@ -923,7 +923,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) - (setq part (mm-replace-in-string part "\n" "\r\n") + (setq part (replace-regexp-in-string part "\n" "\r\n") signature (mm-get-part signature) context (epg-make-context)) (condition-case error @@ -946,8 +946,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defun mml2015-epg-clear-verify () (let ((inhibit-redisplay t) (context (epg-make-context)) - (signature (mm-encode-coding-string (buffer-string) - coding-system-for-write)) + (signature (encode-coding-string (buffer-string) + coding-system-for-write)) plain) (condition-case error (setq plain (epg-verify-string context signature)) @@ -966,7 +966,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (mml2015-epg-verify-result-to-string (epg-context-result-for context 'verify))) (delete-region (point-min) (point-max)) - (insert (mm-decode-coding-string plain coding-system-for-read))) + (insert (decode-coding-string plain coding-system-for-read))) (mml2015-extract-cleartext-signature)))) (defun mml2015-epg-sign (cont) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index f8fefeb..09260cf 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -761,7 +761,7 @@ from the document.") (looking-at "JMF")) (defun nndoc-oe-dbx-type-p () - (looking-at (mm-string-to-multibyte "\317\255\022\376"))) + (looking-at (string-to-multibyte "\317\255\022\376"))) (defun nndoc-read-little-endian () (+ (prog1 (char-after) (forward-char 1)) diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index e60a492..28561c0 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -284,7 +284,7 @@ included.") (defun nneething-encode-file-name (file &optional coding-system) "Encode the name of the FILE in CODING-SYSTEM." (let ((pos 0) buf) - (setq file (mm-encode-coding-string + (setq file (encode-coding-string file (or coding-system nnmail-pathname-coding-system))) (while (string-match "[^-0-9a-zA-Z_:/.]" file pos) (setq buf (cons (format "%%%02x" (aref file (match-beginning 0))) @@ -300,7 +300,7 @@ included.") (setq buf (cons (string (string-to-number (match-string 1 file) 16)) (cons (substring file pos (match-beginning 0)) buf)) pos (match-end 0))) - (mm-decode-coding-string + (decode-coding-string (apply (function concat) (nreverse (cons (substring file pos) buf))) (or coding-system nnmail-pathname-coding-system)))) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index ee60e3e..ff02055 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -1061,7 +1061,7 @@ This command does not work if you use short group names." (defun nnfolder-group-pathname (group) "Make file name for GROUP." (setq group - (mm-encode-coding-string group nnmail-pathname-coding-system)) + (encode-coding-string group nnmail-pathname-coding-system)) (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) ;; If this file exists, we use it directly. (if (or nnmail-use-long-file-names diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index cd43016..c8c95f0 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -621,8 +621,8 @@ the line could be found." (< beg nnheader-max-head-length)))) ;; Finally decode the contents. (when (mm-coding-system-p nnheader-file-coding-system) - (mm-decode-coding-region start (point-max) - nnheader-file-coding-system)))) + (decode-coding-region start (point-max) + nnheader-file-coding-system)))) t)) (defun nnheader-article-p () @@ -842,7 +842,7 @@ without formatting." t)) (defsubst nnheader-replace-chars-in-string (string from to) - (mm-subst-char-in-string from to string)) + (subst-char-in-string from to string)) (defun nnheader-replace-duplicate-chars-in-string (string from to) "Replace characters in STRING from FROM to TO." @@ -898,7 +898,7 @@ without formatting." (if (file-directory-p (concat dir group)) (expand-file-name group dir) ;; If not, we translate dots into slashes. - (expand-file-name (mm-encode-coding-string + (expand-file-name (encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnheader-pathname-coding-system) dir)))) @@ -1102,7 +1102,7 @@ See `find-file-noselect' for the arguments." `(insert-buffer-substring ,buffer ,start ,end) `(if enable-multibyte-characters (insert (with-current-buffer ,buffer - (mm-string-to-multibyte + (string-to-multibyte ,(if (or start end) `(buffer-substring (or ,start (point-min)) (or ,end (point-max))) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 130658c..7ad7b7e 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -234,7 +234,7 @@ textual parts.") (delete-region (+ (match-beginning 0) 2) (point)) (setq string (buffer-substring (point) (+ (point) size))) (delete-region (point) (+ (point) size)) - (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string)))) + (insert (format "%S" (subst-char-in-string ?\n ?\s string)))) (beginning-of-line) (setq article (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 783d1b9..09fd7b3 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1689,7 +1689,7 @@ actually)." `(("query" . ,search) ("HITSPERPAGE" . "999"))))) (unless (featurep 'xemacs) (set-buffer-multibyte t)) - (mm-decode-coding-region (point-min) (point-max) 'utf-8) + (decode-coding-region (point-min) (point-max) 'utf-8) (goto-char (point-min)) (forward-line 1) (while (not (eobp)) @@ -1705,7 +1705,7 @@ actually)." (string-to-number (match-string 2 xref)) xscore) artlist))))) (forward-line 1))) - (apply 'vector (nreverse (mm-delete-duplicates artlist))))) + (apply 'vector (nreverse (delete-dups artlist))))) ;;; Util Code: @@ -1814,18 +1814,19 @@ article came from is also searched." (if (eq (car method) 'nntp) (while (not (eobp)) (ignore-errors - (push (mm-string-as-unibyte + (push (string-as-unibyte (gnus-group-full-name (buffer-substring (point) (progn (skip-chars-forward "^ \t") - (point))) method)) + (point))) + method)) groups)) (forward-line)) (while (not (eobp)) (ignore-errors - (push (mm-string-as-unibyte + (push (string-as-unibyte (if (eq (char-after) ?\") (gnus-group-full-name (read cur) method) (let ((p (point)) (name "")) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 3d4178d..625b417 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -697,7 +697,7 @@ nn*-request-list should have been called before calling this function." (setq group (symbol-name group))) (if (and (numberp (setq max (read buffer))) (numberp (setq min (read buffer)))) - (push (list (mm-string-as-unibyte group) (cons min max)) + (push (list (string-as-unibyte group) (cons min max)) group-assoc))) (error nil)) (widen) @@ -1173,7 +1173,7 @@ FUNC will be called with the group name to determine the article number." 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info) (sit-for 1) '("bogus"))))) - (setq split (mm-delete-duplicates split)) + (setq split (delete-dups split)) ;; The article may be "cross-posted" to `junk'. What ;; to do? Just remove the `junk' spec. Don't really ;; see anything else to do... @@ -1281,7 +1281,7 @@ Return the number of characters in the body." (insert (if (mm-multibyte-p) (mm-string-as-multibyte (format " %s:%d" (caar group-alist) (cdar group-alist))) - (mm-string-as-unibyte + (string-as-unibyte (format " %s:%d" (caar group-alist) (cdar group-alist))))) (setq group-alist (cdr group-alist))) (insert "\n"))) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index c60e845..51048bb 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -242,8 +242,8 @@ as unread by Gnus.") (file-truename (file-name-as-directory (expand-file-name nnmh-toplev)))) dir) - (mm-string-to-multibyte ;Why? Isn't it multibyte already? - (mm-encode-coding-string + (string-to-multibyte ;Why? Isn't it multibyte already? + (encode-coding-string (nnheader-replace-chars-in-string (substring dir (match-end 0)) ?/ ?.) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 28dcd9a..5b471e8 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -128,13 +128,13 @@ non-nil.") "Return a decoded group name of GROUP on SERVER-OR-METHOD." (if nnmail-group-names-not-encoded-p group - (mm-decode-coding-string + (decode-coding-string group (nnml-group-name-charset group server-or-method)))) (defun nnml-encoded-group-name (group &optional server-or-method) "Return an encoded group name of GROUP on SERVER-OR-METHOD." - (mm-encode-coding-string + (encode-coding-string group (nnml-group-name-charset group server-or-method))) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 857c58a..57c3af0 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -115,7 +115,7 @@ for decoding when the cdr that the data specify is not available.") (defun nnrss-decode-group-name (group) (if (and group (mm-coding-system-p 'utf-8)) - (setq group (mm-decode-coding-string group 'utf-8)) + (setq group (decode-coding-string group 'utf-8)) group)) (deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) @@ -412,7 +412,7 @@ otherwise return nil." ;; Decode text according to the encoding attribute. (when (setq cs (nnrss-get-encoding)) (insert (prog1 - (mm-decode-coding-string (buffer-string) cs) + (decode-coding-string (buffer-string) cs) (erase-buffer) (mm-enable-multibyte)))) (goto-char (point-min)) @@ -758,7 +758,7 @@ Read the file and attempt to subscribe to each Feed in the file." Export subscriptions to a buffer in OPML Format." (interactive) (with-current-buffer (get-buffer-create "*OPML Export*") - (mm-set-buffer-file-coding-system 'utf-8) + (set-buffer-file-coding-system 'utf-8) (insert "\n" "\n" "\n" diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index f56b045..d339cb2 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -350,7 +350,7 @@ retried once before actually displaying the error report." (with-current-buffer ,buffer (erase-buffer) (insert (if enable-multibyte-characters - (mm-string-to-multibyte string) + (string-to-multibyte string) string)) (goto-char (point-min)) nil)))) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 925f65f..347a91d 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -514,7 +514,7 @@ Valid types include `google', `dejanews', and `gmane'.") )))) (setq buffer-file-name nil) (unless (featurep 'xemacs) (set-buffer-multibyte t)) - (mm-decode-coding-region (point-min) (point-max) 'utf-8) + (decode-coding-region (point-min) (point-max) 'utf-8) t) (defun nnweb-gmane-identity (url) diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el index d179cbb..71e838a 100644 --- a/lisp/gnus/qp.el +++ b/lisp/gnus/qp.el @@ -59,7 +59,7 @@ them into characters should be done separately." ;; which already contains non-ASCII characters which would ;; then get doubly-decoded below. (if coding-system - (mm-encode-coding-region (point-min) (point-max) coding-system)) + (encode-coding-region (point-min) (point-max) coding-system)) (goto-char (point-min)) (while (and (skip-chars-forward "^=") (not (eobp))) @@ -87,7 +87,7 @@ them into characters should be done separately." (message "Malformed quoted-printable text") (forward-char))))) (if coding-system - (mm-decode-coding-region (point-min) (point-max) coding-system))))) + (decode-coding-region (point-min) (point-max) coding-system))))) (defun quoted-printable-decode-string (string &optional coding-system) "Decode the quoted-printable encoded STRING and return the result. @@ -116,7 +116,7 @@ encode lines starting with \"From\"." (setq class "\010-\012\014\040-\074\076-\177")) (save-excursion (goto-char from) - (if (re-search-forward (mm-string-to-multibyte "[^\x0-\x7f\x80-\xff]") + (if (re-search-forward (string-to-multibyte "[^\x0-\x7f\x80-\xff]") to t) (error "Multibyte character in QP encoding region")) (save-restriction @@ -127,8 +127,7 @@ encode lines starting with \"From\"." (not (eobp))) (insert (prog1 - ;; To unibyte in case of Emacs 23 (unicode) eight-bit. - (format "=%02X" (mm-multibyte-char-to-unibyte (char-after))) + (format "=%02X" (char-after)) (delete-char 1)))) ;; Encode white space at the end of lines. (goto-char (point-min)) @@ -167,7 +166,7 @@ encode lines starting with \"From\"." (defun quoted-printable-encode-string (string) "Encode the STRING as quoted-printable and return the result." (with-temp-buffer - (if (mm-multibyte-string-p string) + (if (multibyte-string-p string) (mm-enable-multibyte) (mm-disable-multibyte)) (insert string) diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el index 1dbd11d..81646b4 100644 --- a/lisp/gnus/rfc1843.el +++ b/lisp/gnus/rfc1843.el @@ -95,7 +95,7 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (match-beginning 1) (match-end 1))) (setq firstc (aref str 0)) - (insert (mm-decode-coding-string + (insert (decode-coding-string (rfc1843-decode (prog1 (substring str 1) diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index 6647d10..be491e9 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -267,7 +267,7 @@ Should be called narrowed to the head of the message." (mm-coding-system-p (car message-posting-charset))) ;; 8 bit must be decoded. - (mm-encode-coding-region + (encode-coding-region (point-min) (point-max) (mm-charset-to-coding-system (car message-posting-charset)))) @@ -294,8 +294,8 @@ Should be called narrowed to the head of the message." (if (boundp 'enable-multibyte-characters) (default-value 'enable-multibyte-characters)) mail-parse-charset) - (mm-encode-coding-region (point) (point-max) - mail-parse-charset))) + (encode-coding-region (point) (point-max) + mail-parse-charset))) ;; We get this when CC'ing messages to newsgroups with ;; 8-bit names. The group name mail copy just got ;; unconditionally encoded. Previously, it would ask @@ -321,7 +321,7 @@ Should be called narrowed to the head of the message." (if (boundp 'enable-multibyte-characters) (default-value 'enable-multibyte-characters))) (featurep 'file-coding)) - (mm-encode-coding-region (point) (point-max) method))) + (encode-coding-region (point) (point-max) method))) ;; Hm. (t))) (goto-char (point-max)))))))) @@ -556,7 +556,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." (if (or debug-on-quit debug-on-error) (signal (car err) (cdr err)) (error "Invalid data for rfc2047 encoding: %s" - (mm-replace-in-string orig-text "[ \t\n]+" " ")))))))) + (replace-regexp-in-string orig-text "[ \t\n]+" " ")))))))) (unless dont-fold (rfc2047-fold-region b (point))) (goto-char (point-max)))) @@ -592,7 +592,7 @@ should not change this value.") ((not rfc2047-encode-max-chars) (concat start (funcall encoder (if cs - (mm-encode-coding-string string cs) + (encode-coding-string string cs) string)) "?=")) ((>= column rfc2047-encode-max-chars) @@ -616,7 +616,7 @@ should not change this value.") (setq next (concat start (funcall encoder (if cs - (mm-encode-coding-string + (encode-coding-string (substring string 0 (1+ index)) cs) (substring string 0 (1+ index)))) @@ -700,7 +700,7 @@ Point moves to the end of the region." (setq crest (buffer-substring-no-properties (point) b))) (setq eword (rfc2047-encode-1 (- b (point-at-bol)) - (mm-replace-in-string + (replace-regexp-in-string (buffer-substring-no-properties b e) "\n\\([ \t]?\\)" "\\1") cs @@ -947,7 +947,7 @@ ENCODED-WORD)." (rfc2047-pad-base64 (nth 2 word))))) ((char-equal ?Q (nth 1 word)) (setq text (quoted-printable-decode-string - (mm-subst-char-in-string + (subst-char-in-string ?_ ? (nth 2 word) t))))) (error (message "%s" (error-message-string code)) @@ -963,7 +963,7 @@ ENCODED-WORD)." (setq words (concat (or (and (setq cs (caar rest)) (condition-case code - (mm-decode-coding-string (cdar rest) cs) + (decode-coding-string (cdar rest) cs) (error (message "%s" (error-message-string code)) nil))) @@ -1087,13 +1087,13 @@ other than `\"' and `\\' in quoted strings." mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-region b e mail-parse-charset)) + (decode-coding-region b e mail-parse-charset)) (setq b (point))) (when (and (mm-multibyte-p) mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-region b (point-max) mail-parse-charset)))))) + (decode-coding-region b (point-max) mail-parse-charset)))))) (defun rfc2047-decode-address-region (start end) "Decode MIME-encoded words in region between START and END. @@ -1123,7 +1123,7 @@ other than `\"' and `\\' in quoted strings." (when address-mime (setq string (with-temp-buffer - (when (mm-multibyte-string-p string) + (when (multibyte-string-p string) (mm-enable-multibyte)) (insert string) (rfc2047-strip-backslashes-in-quoted-strings) @@ -1146,8 +1146,8 @@ other than `\"' and `\\' in quoted strings." ;; string is purely ASCII (eq (detect-coding-string string t) 'undecided)) string - (mm-decode-coding-string string mail-parse-charset)) - (mm-string-to-multibyte string)))) ;; ) + (decode-coding-string string mail-parse-charset)) + (string-to-multibyte string)))) ;; ) (defun rfc2047-decode-address-string (string) "Decode MIME-encoded STRING and return the result. diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el index 34c8ecd..f5f0c81 100644 --- a/lisp/gnus/rfc2231.el +++ b/lisp/gnus/rfc2231.el @@ -63,12 +63,13 @@ must never cause a Lisp error." (let (mod) (when (and (string-match "\\\\\"" string) (not (string-match "\\`\"\\|[^\\]\"" string))) - (setq string (mm-replace-in-string string "\\\\\"" "\"") + (setq string (replace-regexp-in-string string "\\\\\"" "\"") mod t)) (when (and (string-match "\\\\(" string) (string-match "\\\\)" string) (not (string-match "\\`(\\|[^\\][()]" string))) - (setq string (mm-replace-in-string string "\\\\\\([()]\\)" "\\1") + (setq string (replace-regexp-in-string string + "\\\\\\([()]\\)" "\\1") mod t)) (or (and mod (ignore-errors @@ -230,7 +231,7 @@ These look like: ;; Decode using the charset, if any. (if (memq coding-system '(nil ascii)) (buffer-string) - (mm-decode-coding-string (buffer-string) coding-system))))) + (decode-coding-string (buffer-string) coding-system))))) (defun rfc2231-encode-string (param value) "Return and PARAM=VALUE string encoded according to RFC2231. diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 722186e..eb7d862 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -297,8 +297,7 @@ symbol `ask', query before flushing the queue file." (re-search-forward "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t)) (let ((spam-report-gmane-wait - (zerop (% (mm-line-number-at-pos) - spam-report-gmane-max-requests)))) + (zerop (% (line-number-at-pos) spam-report-gmane-max-requests)))) (gnus-message 6 "Reporting %s%s..." (match-string 1) (match-string 2)) (funcall spam-report-url-ping-function diff --git a/lisp/gnus/utf7.el b/lisp/gnus/utf7.el index 9b7191b..2168b7c 100644 --- a/lisp/gnus/utf7.el +++ b/lisp/gnus/utf7.el @@ -185,7 +185,7 @@ Use IMAP modification if FOR-IMAP is non-nil." (defun utf7-latin1-u16-char-converter () "Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode. Characters are converted to raw byte pairs in narrowed buffer." - (mm-encode-coding-region (point-min) (point-max) 'iso-8859-1) + (encode-coding-region (point-min) (point-max) 'iso-8859-1) (mm-disable-multibyte) (goto-char (point-min)) (while (not (eobp)) @@ -201,7 +201,7 @@ Characters are in raw byte pairs in narrowed buffer." (delete-char 1) (error "Unable to convert from Unicode")) (forward-char)) - (mm-decode-coding-region (point-min) (point-max) 'iso-8859-1) + (decode-coding-region (point-min) (point-max) 'iso-8859-1) (mm-enable-multibyte)) ;;;###autoload diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 4e64cfb..72980b7 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -916,14 +916,14 @@ CONFIG is the window configuration before sending mail." ;; use it as the drafts folder. Then copy the skeleton to a regular ;; temp file, and return the regular temp file. (let (new - (temp-folder (mm-make-temp-file + (temp-folder (make-temp-file (concat mh-user-path "draftfolder.") t))) (mh-exec-cmd "comp" "-nowhatnowproc" "-draftfolder" (format "+%s" (file-name-nondirectory temp-folder)) (if (stringp mh-comp-formfile) (list "-form" mh-comp-formfile))) - (setq new (mm-make-temp-file "comp.")) + (setq new (make-temp-file "comp.")) (rename-file (concat temp-folder "/" "1") new t) (delete-file (concat temp-folder "/" ".mh_sequences")) (delete-directory temp-folder) commit 87931c8dc0094facff7c8e27267d630a9254a524 Author: Lars Ingebrigtsen Date: Fri Feb 12 13:38:12 2016 +1100 Remove Message and mm-decode XEmacs compat code * lisp/gnus/message.el: Remove XEmacs compat code. * lisp/gnus/mm-decode.el (mm-create-image-xemacs): Remove. * lisp/gnus/mm-util.el: Remove some XEmacs compat code. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fee7937..b56c5cd 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1629,11 +1629,6 @@ starting with `not' and followed by regexps." (0 'message-mml)))) "Additional expressions to highlight in Message mode.") - -;; XEmacs does it like this. For Emacs, we have to set the -;; `font-lock-defaults' buffer-local variable. -(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) - (defvar message-face-alist '((bold . message-bold-region) (underline . underline-region) @@ -1675,12 +1670,8 @@ news." (defvar message-send-coding-system 'binary "Coding system to encode outgoing mail.") -(defvar message-draft-coding-system - mm-auto-save-coding-system - "*Coding system to compose mail. -If you'd like to make it possible to share draft files between XEmacs -and Emacs, you may use `iso-2022-7bit' for this value at your own risk. -Note that the coding-system `iso-2022-7bit' isn't suitable to all data.") +(defvar message-draft-coding-system mm-auto-save-coding-system + "Coding system to compose mail.") (defcustom message-send-mail-partially-limit nil "The limitation of messages sent as message/partial. @@ -1912,12 +1903,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (defvar message-options nil "Some saved answers when sending message.") -;; FIXME: On XEmacs this causes problems since let-binding like: -;; (let ((message-options message-options)) ...) -;; as in `message-send' and `mml-preview' loses to buffer-local -;; variable initialization. -(unless (featurep 'xemacs) - (make-variable-buffer-local 'message-options)) +(make-variable-buffer-local 'message-options) (defvar message-send-mail-real-function nil "Internal send mail function.") @@ -2645,19 +2631,17 @@ Prefixed with one \\[universal-argument], display the Emacs MIME manual. With two \\[universal-argument]'s, display the EasyPG or PGG manual, depending on the value of `mml2015-use'." (interactive "p") - ;; Don't use `info' because support for `(filename)nodename' is not - ;; available in XEmacs < 21.5.12. - (Info-goto-node (format "(%s)Top" - (cond ((eq arg 16) - (require 'mml2015) - mml2015-use) - ((eq arg 4) 'emacs-mime) - ;; `booleanp' only available in Emacs 22+ - ((and (not (memq arg '(nil t))) - (symbolp arg)) - arg) - (t - 'message))))) + (info (format "(%s)Top" + (cond ((eq arg 16) + (require 'mml2015) + mml2015-use) + ((eq arg 4) 'emacs-mime) + ;; `booleanp' only available in Emacs 22+ + ((and (not (memq arg '(nil t))) + (symbolp arg)) + arg) + (t + 'message))))) @@ -2755,43 +2739,29 @@ PGG manual, depending on the value of `mml2015-use'." ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)] ["Elide Region" message-elide-region :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Replace text in region with an ellipsis"))] + :help "Replace text in region with an ellipsis"] ["Delete Outside Region" message-delete-not-region :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Delete all quoted text outside region"))] + :help "Delete all quoted text outside region"] ["Kill To Signature" message-kill-to-signature t] ["Newline and Reformat" message-newline-and-reformat t] ["Rename buffer" message-rename-buffer t] - ["Spellcheck" ispell-message - ,@(if (featurep 'xemacs) '(t) - '(:help "Spellcheck this message"))] + ["Spellcheck" ispell-message :help "Spellcheck this message"] "----" ["Insert Region Marked" message-mark-inserted-region - :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Mark region with enclosing tags"))] + :active (message-mark-active-p) :help "Mark region with enclosing tags"] ["Insert File Marked..." message-mark-insert-file - ,@(if (featurep 'xemacs) '(t) - '(:help "Insert file at point marked with enclosing tags"))] + :help "Insert file at point marked with enclosing tags"] "----" - ["Send Message" message-send-and-exit - ,@(if (featurep 'xemacs) '(t) - '(:help "Send this message"))] + ["Send Message" message-send-and-exit :help "Send this message"] ["Postpone Message" message-dont-send - ,@(if (featurep 'xemacs) '(t) - '(:help "File this draft message and exit"))] + :help "File this draft message and exit"] ["Send at Specific Time..." gnus-delay-article - ,@(if (featurep 'xemacs) '(t) - '(:help "Ask, then arrange to send message at that time"))] + :help "Ask, then arrange to send message at that time"] ["Kill Message" message-kill-buffer - ,@(if (featurep 'xemacs) '(t) - '(:help "Delete this message without sending"))] + :help "Delete this message without sending"] "----" - ["Message manual" message-info - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the Message manual"))])) + ["Message manual" message-info :help "Display the Message manual"])) (easy-menu-define message-mode-field-menu message-mode-map "" @@ -2805,15 +2775,12 @@ PGG manual, depending on the value of `mml2015-use'." ["Fcc" message-goto-fcc t] ["Reply-To" message-goto-reply-to t] ["Flag As Important" message-insert-importance-high - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark this message as important"))] + :help "Mark this message as important"] ["Flag As Unimportant" message-insert-importance-low - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark this message as unimportant"))] + :help "Mark this message as unimportant"] ["Request Receipt" message-insert-disposition-notification-to - ,@(if (featurep 'xemacs) '(t) - '(:help "Request a receipt notification"))] + :help "Request a receipt notification"] "----" ;; (typical) news stuff ["Summary" message-goto-summary t] @@ -2829,18 +2796,14 @@ PGG manual, depending on the value of `mml2015-use'." "----" ;; (typical) mailing-lists stuff ["Fetch To" message-insert-to - ,@(if (featurep 'xemacs) '(t) - '(:help "Insert a To header that points to the author."))] + :help "Insert a To header that points to the author."] ["Fetch To and Cc" message-insert-wide-reply - ,@(if (featurep 'xemacs) '(t) - '(:help - "Insert To and Cc headers as if you were doing a wide reply."))] + :help "Insert To and Cc headers as if you were doing a wide reply."] "----" ["Send to list only" message-to-list-only t] ["Mail-Followup-To" message-goto-mail-followup-to t] ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to - ,@(if (featurep 'xemacs) '(t) - '(:help "Insert a reasonable `Mail-Followup-To:' header."))] + :help "Insert a reasonable `Mail-Followup-To:' header."] ["Reduce To: to Cc:" message-reduce-to-to-cc t] "----" ["Sort Headers" message-sort-headers t] @@ -2886,7 +2849,6 @@ message composition doesn't break too bad." ;; category, face, display: probably doesn't do any harm. ;; fontified: is used by font-lock. ;; syntax-table, local-map: I dunno. - ;; We need to add XEmacs names to the list. "Property list of with properties forbidden in message buffers. The values of the properties are ignored, only the property names are used.") @@ -3021,12 +2983,10 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (set (make-local-variable 'comment-start) message-yank-prefix) (set (make-local-variable 'comment-start-skip) (concat "^" (regexp-quote message-yank-prefix) "[ \t]*"))) - (if (featurep 'xemacs) - (message-setup-toolbar) - (set (make-local-variable 'font-lock-defaults) - '(message-font-lock-keywords t)) - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) (message-make-tool-bar)))) + (set (make-local-variable 'font-lock-defaults) + '(message-font-lock-keywords t)) + (if (boundp 'tool-bar-map) + (set (make-local-variable 'tool-bar-map) (message-make-tool-bar))) (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) ;; Mmmm... Forbidden properties... @@ -6397,9 +6357,6 @@ multiple lines is treated as a single line. Otherwise, even if N is 1, when point is on a continuation header line, it will be moved to the beginning " (interactive "p") - (let ((zrs 'zmacs-region-stays)) - (when (and (featurep 'xemacs) (interactive-p) (boundp zrs)) - (set zrs t))) (cond ;; Go to beginning of header or beginning of line. ((and message-beginning-of-line (message-point-in-header-p)) @@ -7470,14 +7427,13 @@ Optional DIGEST will use digest to forward." (let ((b (point)) (contents (with-current-buffer forward-buffer (buffer-string))) e) - (unless (featurep 'xemacs) - (unless (mm-multibyte-string-p contents) - (error "Attempt to insert unibyte string from the buffer \"%s\"\ + (unless (mm-multibyte-string-p contents) + (error "Attempt to insert unibyte string from the buffer \"%s\"\ to the multibyte buffer \"%s\"" - (if (bufferp forward-buffer) - (buffer-name forward-buffer) - forward-buffer) - (buffer-name)))) + (if (bufferp forward-buffer) + (buffer-name forward-buffer) + forward-buffer) + (buffer-name))) (insert (mm-with-multibyte-buffer (insert contents) (mime-to-mml) @@ -7534,14 +7490,13 @@ Optional DIGEST will use digest to forward." (let ((b (point)) e) (if (not message-forward-decoded-p) (let ((contents (with-current-buffer forward-buffer (buffer-string)))) - (unless (featurep 'xemacs) - (unless (mm-multibyte-string-p contents) - (error "Attempt to insert unibyte string from the buffer \"%s\"\ + (unless (mm-multibyte-string-p contents) + (error "Attempt to insert unibyte string from the buffer \"%s\"\ to the multibyte buffer \"%s\"" - (if (bufferp forward-buffer) - (buffer-name forward-buffer) - forward-buffer) - (buffer-name)))) + (if (bufferp forward-buffer) + (buffer-name forward-buffer) + forward-buffer) + (buffer-name))) (insert (mm-with-multibyte-buffer (insert contents) (mime-to-mml) @@ -7988,8 +7943,7 @@ See `gmm-tool-bar-from-list' for the format of the list." (defun message-make-tool-bar (&optional force) "Make a message mode tool bar from `message-tool-bar-list'. When FORCE, rebuild the tool bar." - (when (and (not (featurep 'xemacs)) - (boundp 'tool-bar-mode) + (when (and (boundp 'tool-bar-mode) tool-bar-mode (or (not message-tool-bar-map) force)) (setq message-tool-bar-map @@ -8577,10 +8531,6 @@ Used in `message-simplify-recipients'." (match-beginning 0) " "))))))) -(when (featurep 'xemacs) - (require 'messagexmas) - (message-xmas-redefine)) - (provide 'message) (run-hooks 'message-load-hook) diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 11449f9..cd57695 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -255,9 +255,6 @@ decoding. If it is nil, default to `mail-parse-charset'." (setq coding-system (mm-charset-to-coding-system mail-parse-charset))) (when (and charset coding-system - ;; buffer-file-coding-system - ;;Article buffer is nil coding system - ;;in XEmacs (mm-multibyte-p) (or (not (eq coding-system 'ascii)) (setq coding-system mail-parse-charset))) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 810560a..d1240c0 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -289,10 +289,7 @@ before the external MIME handler is invoked." (mm-insert-part handle) (let ((image (ignore-errors - (if (fboundp 'create-image) - (create-image (buffer-string) 'imagemagick 'data-p) - (mm-create-image-xemacs - (mm-handle-media-subtype handle)))))) + (create-image (buffer-string) 'imagemagick 'data-p)))) (when image (setcar (cdr handle) (list "image/imagemagick")) (mm-image-fit-p handle))))))) @@ -1147,9 +1144,6 @@ external if displayed external." (ignore-errors (cond ;; Internally displayed part. - ((mm-annotationp object) - (if (featurep 'xemacs) - (delete-annotation object))) ((or (functionp object) (and (listp object) (eq (car object) 'lambda))) @@ -1573,73 +1567,30 @@ be determined." (prog1 (setq spec (ignore-errors - ;; Avoid testing `make-glyph' since W3 may define - ;; a bogus version of it. - (if (fboundp 'create-image) - (create-image (buffer-string) - (or (mm-image-type-from-buffer) - (intern type)) - 'data-p) - (mm-create-image-xemacs type)))) + (create-image (buffer-string) + (or (mm-image-type-from-buffer) + (intern type)) + 'data-p))) (mm-handle-set-cache handle spec)))))) -(defun mm-create-image-xemacs (type) - (when (featurep 'xemacs) - (cond - ((equal type "xbm") - ;; xbm images require special handling, since - ;; the only way to create glyphs from these - ;; (without a ton of work) is to write them - ;; out to a file, and then create a file - ;; specifier. - (let ((file (mm-make-temp-file - (expand-file-name "emm" mm-tmp-directory) - nil ".xbm"))) - (unwind-protect - (progn - (write-region (point-min) (point-max) file) - (make-glyph (list (cons 'x file)))) - (ignore-errors - (delete-file file))))) - (t - (make-glyph - (vector - (or (mm-image-type-from-buffer) - (intern type)) - :data (buffer-string))))))) - (declare-function image-size "image.c" (spec &optional pixels frame)) (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) (or (not image) - (if (featurep 'xemacs) - ;; XEmacs's glyphs can actually tell us about their width, so - ;; let's be nice and smart about them. - (or mm-inline-large-images - (and (<= (glyph-width image) (window-pixel-width)) - (<= (glyph-height image) (window-pixel-height)))) - (let* ((size (image-size image)) - (w (car size)) - (h (cdr size))) - (or mm-inline-large-images - (and (<= h (1- (window-height))) ; Don't include mode line. - (<= w (window-width))))))))) + (let* ((size (image-size image)) + (w (car size)) + (h (cdr size))) + (or mm-inline-large-images + (and (<= h (1- (window-height))) ; Don't include mode line. + (<= w (window-width)))))))) (defun mm-valid-image-format-p (format) "Say whether FORMAT can be displayed natively by Emacs." - (cond - ;; Handle XEmacs - ((fboundp 'valid-image-instantiator-format-p) - (valid-image-instantiator-format-p format)) - ;; Handle Emacs - ((fboundp 'image-type-available-p) - (and (display-graphic-p) - (image-type-available-p format))) - ;; Nobody else can do images yet. - (t - nil))) + (and (fboundp 'image-type-available-p) + (display-graphic-p) + (image-type-available-p format))) (defun mm-valid-and-fit-image-p (format handle) "Say whether FORMAT can be displayed natively and HANDLE fits the window." diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el index 523a53b..2b037f1 100644 --- a/lisp/gnus/mm-partial.el +++ b/lisp/gnus/mm-partial.el @@ -136,13 +136,6 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." handle `(lambda () (let (buffer-read-only) - (condition-case nil - ;; This is only valid on XEmacs. - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) - '(background background-pixmap foreground)) - (error nil)) (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) (provide 'mm-partial) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index b8da19d..9deca23 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -25,13 +25,7 @@ (eval-when-compile (require 'cl)) (require 'mail-prsvr) - -(eval-and-compile - (if (featurep 'xemacs) - (unless (ignore-errors - (require 'timer-funcs)) - (require 'timer)) - (require 'timer))) +(require 'timer) (defvar mm-mime-mule-charset-alist ) ;; Note this is not presently used on Emacs >= 23, which is good, @@ -57,8 +51,6 @@ (char-int . identity) ;; `coding-system-equal' is an Emacs function, not available in XEmacs. (coding-system-equal . equal) - ;; `annotationp' is an XEmacs function, not available in Emacs. - (annotationp . ignore) ;; `set-buffer-file-coding-system' is not available in XEmacs 21.4 ;; built without the `file-coding' feature. (set-buffer-file-coding-system . ignore)