;; Fixme: This isn't the right thing for mixed graphical and non-graphical
;; frames in a session.
(defcustom gnus-article-x-face-command
- (if (featurep 'xemacs)
- (if (or (gnus-image-type-available-p 'xface)
- (gnus-image-type-available-p 'pbm))
- 'gnus-display-x-face-in-from
- "{ echo \
+ (if (gnus-image-type-available-p 'pbm)
+ 'gnus-display-x-face-in-from
+ "{ echo \
'/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
-; uncompface; } | icontopbm | ee -")
- (if (gnus-image-type-available-p 'pbm)
- 'gnus-display-x-face-in-from
- "{ echo \
-'/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
-; uncompface; } | icontopbm | display -"))
+; uncompface; } | icontopbm | display -")
"*String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
Example: (_/*word*/_)."
:group 'gnus-article-emphasis)
-(defface gnus-emphasis-strikethru (if (featurep 'xemacs)
- '((t (:strikethru t)))
- '((t (:strike-through t))))
+(defface gnus-emphasis-strikethru '((t (:strike-through t)))
"Face used for displaying strike-through text (-word-)."
:group 'gnus-article-emphasis)
:type 'hook
:group 'gnus-article-various)
-(when (featurep 'xemacs)
- ;; Extracted from gnus-xmas-define in order to preserve user settings
- (when (fboundp 'turn-off-scroll-in-place)
- (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
- ;; Extracted from gnus-xmas-redefine in order to preserve user settings
- (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
-
(defcustom gnus-article-menu-hook nil
"*Hook run after the creation of the article mode menu."
:type 'hook
(item :tag "skip" nil)
(face :value default)))))
-(defcustom gnus-face-properties-alist (if (featurep 'xemacs)
- '((xface . (:face gnus-x-face)))
- '((pbm . (:face gnus-x-face))
- (png . nil)))
+(defcustom gnus-face-properties-alist '((pbm . (:face gnus-x-face))
+ (png . nil))
"Alist of image types and properties applied to Face and X-Face images.
Here are examples:
See the manual for the valid properties for various image types.
Currently, `pbm' is used for X-Face images and `png' is used for Face
-images in Emacs. Only the `:face' property is effective on the `xface'
-image type in XEmacs if it is built with the libcompface library."
+images in Emacs."
:version "23.1" ;; No Gnus
:group 'gnus-article-headers
:type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
(defcustom gnus-treat-display-x-face
(and (not noninteractive)
(gnus-image-type-available-p 'xbm)
- (if (featurep 'xemacs)
- (featurep 'xface)
- (condition-case nil
- (and (string-match "^0x" (shell-command-to-string "uncompface"))
- (executable-find "icontopbm"))
- ;; shell-command-to-string may signal an error, e.g. if
- ;; shell-file-name is not found.
- (error nil)))
+ (condition-case nil
+ (and (string-match "^0x" (shell-command-to-string "uncompface"))
+ (executable-find "icontopbm"))
+ ;; shell-command-to-string may signal an error, e.g. if
+ ;; shell-file-name is not found.
+ (error nil))
'head)
"Display X-Face headers.
Valid values are nil and `head'.
(- gnus-article-normalized-header-length column)
? )))
((> column gnus-article-normalized-header-length)
- (gnus-put-text-property
+ (put-text-property
(progn
(forward-char gnus-article-normalized-header-length)
(point))
"Translate many Unicode characters into their ASCII equivalents."
(interactive)
(require 'org-entities)
- (let ((table (make-char-table (if (featurep 'xemacs) 'generic))))
+ (let ((table (make-char-table nil)))
(dolist (elem org-entities)
(when (and (listp elem)
(= (length (nth 6 elem)) 1))
- (if (featurep 'xemacs)
- (put-char-table (aref (nth 6 elem) 0) (nth 4 elem) table)
- (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem)))))
+ (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem))))
(save-excursion
(when (article-goto-body)
(let ((inhibit-read-only t)
replace props)
(while (not (eobp))
- (if (not (setq replace (if (featurep 'xemacs)
- (get-char-table (following-char) table)
- (aref table (following-char)))))
+ (if (not (setq replace (aref table (following-char))))
(forward-char 1)
(if (prog1
(setq props (text-properties-at (point)))
(setq truncate-lines nil))
((numberp arg)
(setq truncate-lines t)))
- ;; In versions of Emacs 22 (CVS) before 2006-05-26,
- ;; `toggle-truncate-lines' needs an argument.
(toggle-truncate-lines)))
(defun gnus-article-treat-body-boundary ()
(goto-char (point-max))
(let ((start (point)))
(insert "X-Boundary: ")
- (gnus-add-text-properties start (point) gnus-hidden-properties)
+ (add-text-properties start (point) gnus-hidden-properties)
(insert (let (str (max (window-width)))
- (if (featurep 'xemacs)
- (setq max (1- max)))
(while (>= max (length str))
(setq str (concat str gnus-body-boundary-delimiter)))
(substring str 0 max))
"\n")
- (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
+ (put-text-property start (point) 'gnus-decoration 'header)))))
(defun article-fill-long-lines ()
"Fill lines that are wider than the window width."
;; The command is a string, so we interpret the command
;; as a, well, command, and fork it off.
(let ((process-connection-type nil))
- (gnus-set-process-query-on-exit-flag
+ (set-process-query-on-exit-flag
(start-process
"article-x-face" nil shell-file-name
shell-command-switch gnus-article-x-face-command)
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)))
(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
(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
(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)))))))
-(eval-when-compile
- (require 'rfc1843))
+(declare-function rfc1843-decode-region "rfc1843" (from to))
(defun article-decode-HZ ()
"Translate a HZ-encoded article."
(while (re-search-forward
"\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
(replace-match "\\1\\3" t)))
- (when (gmm-called-interactively-p 'any)
+ (when (called-interactively-p 'any)
(gnus-treat-article nil))))
(defun article-wash-html ()
(cond ((file-directory-p file)
(when (or (not (eq how 'file))
(gnus-y-or-n-p
- (gnus-format-message
+ (format-message
"Delete temporary HTML file(s) in directory `%s'? "
(file-name-as-directory file))))
(gnus-delete-directory file)))
<img[\t\n ]+\\(?:[^\t\n >]+[\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)
(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.
;; 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)
(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)
(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))
(setq command
(if (and (eq command 'default) default)
default
- (gnus-read-shell-command "Shell command on this article: "
- default))))
+ (read-shell-command "Shell command on this article: " default))))
(when (string-equal command "")
(if default
(setq command default)
(put-text-property (match-end 0) (point-max)
'face eface)))))))))
-(autoload 'canlock-verify "canlock" nil t) ;; for XEmacs.
-
(defun article-verify-cancel-lock ()
"Verify Cancel-Lock header."
(interactive)
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
(defvar gnus-article-send-map)
-
(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
- "W" gnus-article-wide-reply-with-original)
-(if (featurep 'xemacs)
- (set-keymap-default-binding gnus-article-send-map
- 'gnus-article-read-summary-send-keys)
- (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys))
+ "W" gnus-article-wide-reply-with-original
+ [t] 'gnus-article-read-summary-send-keys)
(defun gnus-article-make-menu-bar ()
(unless (boundp 'gnus-article-commands-menu)
(make-local-variable 'gnus-article-ignored-charsets)
(set (make-local-variable 'bookmark-make-record-function)
'gnus-summary-bookmark-make-record)
- ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space'
- ;; face.
+ ;; Prevent Emacs from displaying non-break space with
+ ;; `nobreak-space' face.
(set (make-local-variable 'nobreak-char-display) nil)
;; Enable `gnus-article-remove-images' to delete images shr.el renders.
(set (make-local-variable 'shr-put-image-function) 'gnus-shr-put-image)
(defun gnus-article-stop-animations ()
(dolist (timer (and (boundp 'timer-list)
timer-list))
- (when (eq (gnus-timer--function timer) 'image-animate-timeout)
+ (when (eq (timer--function timer) 'image-animate-timeout)
(cancel-timer timer))))
(defun gnus-stop-downloads ()
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
+ (when transient-mark-mode
(setq mark-active nil))
(if (not (setq result (let ((inhibit-read-only t))
(gnus-request-article-this-buffer
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
- (define-key map gnus-mouse-2 'gnus-article-push-button)
- (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
+ (define-key map [mouse-2] 'gnus-article-push-button)
+ (define-key map [down-mouse-3] 'gnus-mime-button-menu)
(dolist (c gnus-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
(set (make-local-variable 'mml-buffer-list) mbl1))
- (gnus-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
`(lambda (no-highlight)
(let ((mail-parse-charset (or gnus-article-charset
((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
(not (eq coding-system 'ascii))))
(progn
(mm-enable-multibyte)
- (insert (mm-decode-coding-string contents coding-system))
- (setq buffer-file-coding-system
- (if (boundp 'last-coding-system-used)
- (symbol-value 'last-coding-system-used)
- coding-system)))
+ (insert (decode-coding-string contents coding-system))
+ (setq buffer-file-coding-system last-coding-system-used))
(mm-disable-multibyte)
(insert contents)
(setq buffer-file-coding-system mm-binary-coding-system))
(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
(let ((displayed-p (mm-handle-displayed-p handle)))
(gnus-insert-mime-button handle (get-text-property btn 'gnus-part)
(list displayed-p))
- (if (featurep 'emacs)
- (delete-region
- (point)
- (next-single-property-change (point) 'gnus-data nil (point-max)))
- (let* ((end (next-single-property-change (point) 'gnus-data))
- (annots (annotations-at (or end (point-max)))))
- (delete-region (point)
- (if end
- (if annots (1+ end) end)
- (point-max)))
- (dolist (annot annots)
- (set-extent-endpoints annot (point) (point)))))
+ (delete-region
+ (point)
+ (next-single-property-change (point) 'gnus-data nil (point-max)))
(setq start (point))
(if (search-backward "\n\n" nil t)
(progn
(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)
window
(setq window (selected-window))
;; Article may be displayed in the other frame.
- (gnus-select-frame-set-input-focus
+ (select-frame-set-input-focus
(prog1
frame
(setq frame (selected-frame))))))
(get-text-property (point) 'gnus-data))))
(set-marker overlay-arrow-position nil)
(unless gnus-auto-select-part
- (gnus-select-frame-set-input-focus frame)
+ (select-frame-set-input-focus frame)
(select-window window))))
t))
(if gnus-inhibit-mime-unbuttonizing
;; Toggle the button appearance between `[button]...' and `[button]'.
(let ((displayed-p (mm-handle-displayed-p handle)))
(gnus-insert-mime-button handle id (list displayed-p))
- (if (featurep 'emacs)
- (delete-region
- (point)
- (next-single-property-change (point) 'gnus-data nil (point-max)))
- (let* ((end (next-single-property-change (point) 'gnus-data))
- (annots (annotations-at (or end (point-max)))))
- (delete-region (point)
- (if end
- (if annots (1+ end) end)
- (point-max)))
- (dolist (annot annots)
- (set-extent-endpoints annot (point) (point)))))
+ (delete-region
+ (point)
+ (next-single-property-change (point) 'gnus-data nil (point-max)))
(setq start (point))
(if (search-backward "\n\n" nil t)
(progn
:button-keymap gnus-mime-button-map
:help-echo
(lambda (widget)
- ;; Needed to properly clear the message due to a bug in
- ;; wid-edit (XEmacs only).
- (if (boundp 'help-echo-owns-message)
- (setq help-echo-owns-message t))
(format
"%S: %s the MIME part; %S: more options"
- (aref gnus-mouse-2 0)
+ 'mouse-2
(if (mm-handle-displayed-p (widget-get widget :mime-handle))
"hide" "show")
- (aref gnus-down-mouse-3 0))))))
+ 'down-mouse-3)))))
(defun gnus-widget-press-button (elems _el)
(goto-char (widget-get elems :from))
(defun gnus-article-insert-newline ()
"Insert a newline, but mark it as undeletable."
- (gnus-put-text-property
- (point) (progn (insert "\n") (point)) 'gnus-undeletable t))
+ (put-text-property (point) (progn (insert "\n") (point)) 'gnus-undeletable t))
(defun gnus-mime-display-alternative (handles &optional preferred ibegend id)
(let* ((preferred (or preferred (mm-preferred-alternative handles)))
(not preferred)
(not (gnus-unbuttonized-mime-type-p
"multipart/alternative")))
- (gnus-add-text-properties
+ (add-text-properties
(setq from (point))
(progn
(insert (format "%d. " id))
(gnus-mime-display-alternative
',ihandles ',not-pref ',begend ,id))
keymap ,gnus-mime-button-map
- ,gnus-mouse-face-prop ,gnus-article-mouse-face
+ mouse-face ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
article-type multipart
rear-nonsticky t))
(widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
+ :action 'gnus-widget-press-button)
;; Do the handles
(while (setq handle (pop handles))
- (gnus-add-text-properties
+ (add-text-properties
(setq from (point))
(progn
(insert (format "(%c) %-18s"
(gnus-mime-display-alternative
',ihandles ',handle ',begend ,id))
keymap ,gnus-mime-button-map
- ,gnus-mouse-face-prop ,gnus-article-mouse-face
+ mouse-face ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
gnus-data ,handle
rear-nonsticky t))
(widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
+ :action 'gnus-widget-press-button)
(insert " "))
(insert "\n\n"))
(when preferred
(not (with-current-buffer gnus-summary-buffer
gnus-have-all-headers)))
(not gnus-inhibit-hiding))
- (gnus-article-hide-headers)))
+ (article-hide-headers)))
(declare-function shr-put-image "shr" (data alt &optional flags))
(when coding
;; If the coding system is not suitable to encode the text,
;; ask a user for a proper one.
- (when (fboundp 'select-safe-coding-system)
- (setq coding (coding-system-base
- (save-window-excursion
- (select-safe-coding-system (point-min) (point-max)
- coding))))
- (setq coding-system-for-write
- (or (cdr (assq coding '((mule-utf-8 . utf-8))))
- coding)))
+ (setq coding (coding-system-base
+ (save-window-excursion
+ (select-safe-coding-system (point-min) (point-max)
+ coding))))
+ (setq coding-system-for-write
+ (or (cdr (assq coding '((mule-utf-8 . utf-8))))
+ coding))
(goto-char (point-min))
;; Add the coding cookie.
(insert (format "X-Gnus-Coding-System: -*- coding: %s; -*-\n\n"
(interactive)
(when (gnus-article-next-page)
(goto-char (point-min))
- (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
+ (gnus-article-read-summary-keys nil ?n)))
(defun gnus-article-goto-prev-page ()
"Show the previous page of the article."
(interactive)
(if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer?
- (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
+ (gnus-article-read-summary-keys nil ?p)
(gnus-article-prev-page nil)))
;; This is cleaner but currently breaks `gnus-pick-mode':
If end of article, return non-nil. Otherwise return nil.
Argument LINES specifies lines to be scrolled up."
(interactive "p")
- (move-to-window-line (if (featurep 'xemacs) -1 (- -1 scroll-margin)))
+ (move-to-window-line (- -1 scroll-margin))
(if (and (not (and gnus-article-over-scroll
(> (count-lines (window-start) (point-max))
- (if (featurep 'xemacs)
- (or lines (1- (window-height)))
- (+ (or lines (1- (window-height))) scroll-margin)))))
+ (+ (or lines (1- (window-height))) scroll-margin))))
(save-excursion
(end-of-line)
(and (pos-visible-in-window-p) ;Not continuation line.
(defun gnus-article-beginning-of-window ()
"Move point to the beginning of the window.
-In Emacs, the point is placed at the line number which `scroll-margin'
+The point is placed at the line number which `scroll-margin'
specifies."
- (if (featurep 'xemacs)
- (move-to-window-line 0)
- ;; There is an obscure bug in Emacs that makes it impossible to
- ;; scroll past big pictures in the article buffer. Try to fix
- ;; this by adding a sanity check by counting the lines visible.
- (when (> (count-lines (window-start) (window-end)) 30)
- (move-to-window-line
- (min (max 0 scroll-margin)
- (max 1 (- (window-height)
- (if mode-line-format 1 0)
- (if header-line-format 1 0)
- 2)))))))
+ ;; There is an obscure bug in Emacs that makes it impossible to
+ ;; scroll past big pictures in the article buffer. Try to fix
+ ;; this by adding a sanity check by counting the lines visible.
+ (when (> (count-lines (window-start) (window-end)) 30)
+ (move-to-window-line
+ (min (max 0 scroll-margin)
+ (max 1 (- (window-height)
+ (if mode-line-format 1 0)
+ (if header-line-format 1 0)
+ 2))))))
(defvar scroll-in-place)
(goto-char (point-max))
(recenter (if gnus-article-over-scroll
(if lines
- (max (if (featurep 'xemacs)
- lines
- (+ lines scroll-margin))
- 3)
+ (max (+ lines scroll-margin) 3)
(- (window-height) 2))
-1)))
(prog1
(let (gnus-pick-mode)
(setq unread-command-events (nconc unread-command-events
(list (or key last-command-event)))
- keys (if (featurep 'xemacs)
- (events-to-keys (read-key-sequence nil t))
- (read-key-sequence nil t)))))
+ keys (read-key-sequence nil t))))
(message "")
(article 1.0)))))))
(gnus-configure-windows 'article))
(setq win (get-buffer-window summary-buffer 'visible)))
- (gnus-select-frame-set-input-focus (window-frame win))
+ (select-frame-set-input-focus (window-frame win))
(select-window win))))
(setq in-buffer (current-buffer))
;; We disable the pick minor mode commands.
(defun gnus-article-read-summary-send-keys ()
(interactive)
- (let ((unread-command-events (list (gnus-character-to-event ?S))))
+ (let ((unread-command-events (list ?S)))
(gnus-article-read-summary-keys)))
(defun gnus-article-describe-key (key)
"Display documentation of the function invoked by KEY.
KEY is a string or a vector."
- (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
+ (interactive (list (let ((cursor-in-echo-area t))
(read-key-sequence "Describe key: "))))
(gnus-article-check-buffer)
(if (memq (key-binding key t) '(gnus-article-read-summary-keys
gnus-article-read-summary-send-keys))
(with-current-buffer gnus-article-current-summary
(setq unread-command-events
- (if (featurep 'xemacs)
- (append key unread-command-events)
- (nconc
- (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
- (list 'meta (- x 128))
- x))
- key)
- unread-command-events)))
+ (nconc
+ (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+ (list 'meta (- x 128))
+ x))
+ key)
+ unread-command-events))
(let ((cursor-in-echo-area t)
gnus-pick-mode)
(describe-key (read-key-sequence nil t))))
(defun gnus-article-describe-key-briefly (key &optional insert)
"Display documentation of the function invoked by KEY.
KEY is a string or a vector."
- (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
+ (interactive (list (let ((cursor-in-echo-area t))
(read-key-sequence "Describe key: "))
current-prefix-arg))
(gnus-article-check-buffer)
gnus-article-read-summary-send-keys))
(with-current-buffer gnus-article-current-summary
(setq unread-command-events
- (if (featurep 'xemacs)
- (append key unread-command-events)
- (nconc
- (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
- (list 'meta (- x 128))
- x))
- key)
- unread-command-events)))
+ (nconc
+ (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+ (list 'meta (- x 128))
+ x))
+ key)
+ unread-command-events))
(let ((cursor-in-echo-area t)
gnus-pick-mode)
(describe-key-briefly (read-key-sequence nil t) insert)))
(interactive)
(let ((article (cdr gnus-article-current))
contents)
- (if (not (gnus-region-active-p))
+ (if (not (and transient-mark-mode mark-active))
(with-current-buffer gnus-summary-buffer
(gnus-summary-reply (list (list article)) wide))
(setq contents (buffer-substring (point) (mark t)))
;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
+ (when transient-mark-mode
(setq mark-active nil))
(with-current-buffer gnus-summary-buffer
(gnus-summary-reply
(interactive)
(let ((article (cdr gnus-article-current))
contents)
- (if (not (gnus-region-active-p))
+ (if (not (and transient-mark-mode mark-active))
(with-current-buffer gnus-summary-buffer
(gnus-summary-followup (list (list article))))
(setq contents (buffer-substring (point) (mark t)))
;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
+ (when transient-mark-mode
(setq mark-active nil))
(with-current-buffer gnus-summary-buffer
(gnus-summary-followup
hidden.
If given a prefix, show the hidden text instead."
(interactive (append (gnus-article-hidden-arg) (list 'force)))
- (gnus-article-hide-headers arg)
- (gnus-article-hide-list-identifiers arg)
- (gnus-article-hide-citation-maybe arg force)
- (gnus-article-hide-signature arg))
+ (gnus-with-article-buffer
+ (article-hide-headers arg)
+ (article-hide-list-identifiers)
+ (gnus-article-hide-citation-maybe arg force)
+ (article-hide-signature arg)))
(defun gnus-check-group-server ()
;; Make sure the connection to the server is alive.
;; 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)
(when (and (not force)
(gnus-group-read-only-p))
(error "The current newsgroup does not support article editing"))
- (gnus-article-date-original)
+ (gnus-with-article-buffer
+ (article-date-original))
(gnus-article-edit-article
'ignore
`(lambda (no-highlight)
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
"nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
"\\(//[-a-z0-9_.]+:[0-9]*\\)?"
- (if (string-match "[[:digit:]]" "1") ;; Support POSIX?
- (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
- (punct "!?:;.,"))
- (concat
- "\\(?:"
- ;; Match paired parentheses, e.g. in Wikipedia URLs:
- ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
- "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
- "\\|"
- "[" chars punct "]+" "[" chars "]"
- "\\)"))
- (concat ;; XEmacs 21.4 doesn't support POSIX.
- "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+"
- "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)"))
+ (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
+ (punct "!?:;.,"))
+ (concat
+ "\\(?:"
+ ;; Match paired parentheses, e.g. in Wikipedia URLs:
+ ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
+ "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
+ "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
+ "\\|"
+ "[" chars punct "]+" "[" chars "]"
+ "\\)"))
"\\)")
"Regular expression that matches URLs."
:version "24.4"
:group 'gnus-article-buttons
:type 'regexp)
-(defcustom gnus-button-valid-fqdn-regexp
- message-valid-fqdn-regexp
+(defcustom gnus-button-valid-fqdn-regexp "\\([-A-Za-z0-9]+\\.\\)+[A-Za-z]+"
"Regular expression that matches a valid FQDN."
- :version "22.1"
+ :version "25.2"
:group 'gnus-article-buttons
:type 'regexp)
(list gnus-button-mid-or-mail-heuristic-alist)
(result 0) rate regexp lpartlen elem)
(setq lpartlen
- (length (gnus-replace-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
(setq guessed
;; get rid of surrounding angles...
(funcall pref
- (gnus-replace-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)))
"Call `describe-function' when pushing the corresponding URL button."
(describe-function
(intern
- (gnus-replace-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
- (gnus-replace-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.
(defun gnus-button-handle-describe-key (url)
"Call `describe-key' when pushing the corresponding URL button."
(let* ((key-string
- (gnus-replace-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)
(defun gnus-button-handle-apropos (url)
"Call `apropos' when pushing the corresponding URL button."
- (apropos (gnus-replace-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
- (gnus-replace-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)
- (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+ (apropos-variable
+ (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)
- (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+ (apropos-documentation
+ (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 (gnus-replace-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))))
(when (and header-face
(not (memq (point) hpoints)))
(push (point) hpoints)
- (gnus-put-text-property from (point) 'face header-face))
+ (put-text-property from (point) 'face header-face))
(when (and field-face
(not (memq (setq from (point)) fpoints)))
(push from fpoints)
(if (re-search-forward "^[^ \t]" nil t)
(forward-char -2)
(goto-char (point-max)))
- (gnus-put-text-property from (point) 'face field-face)))))))
+ (put-text-property from (point) 'face field-face)))))))
(defun gnus-article-highlight-signature ()
"Highlight the signature in an article.
(gnus-article-extend-url-button from start end))
(gnus-article-add-button start end
'gnus-button-push (list from entry))
- (gnus-put-text-property
+ (put-text-property
start end
'gnus-string (buffer-substring-no-properties
start end))))))))))
(when gnus-article-button-face
(overlay-put (make-overlay from to nil t)
'face gnus-article-button-face))
- (gnus-add-text-properties
+ (add-text-properties
from to
(nconc (and gnus-article-mouse-face
- (list gnus-mouse-face-prop gnus-article-mouse-face))
+ (list 'mouse-face gnus-article-mouse-face))
(list 'gnus-callback fun)
(and data (list 'gnus-data data))))
(widget-convert-button 'link from to :action 'gnus-widget-press-button
:help-echo (or text "Follow the link")
- :keymap gnus-url-button-map
- :button-keymap gnus-widget-button-keymap))
+ :keymap gnus-url-button-map))
(defun gnus-article-copy-string ()
"Copy the string in the button to the kill ring."
"Fetch a man page."
(gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
(when (eq gnus-button-man-handler 'woman)
- (setq url (gnus-replace-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))
(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
")" (gnus-url-unhex-string (match-string 2 url)))))
((string-match "([^)\"]+)[^\"]+" url)
(setq url
- (gnus-replace-in-string
- (gnus-replace-in-string url "[\n\t ]+" " ") "\"" ""))
+ (replace-regexp-in-string
+ "\"" "" (replace-regexp-in-string "[\n\t ]+" " " url)))
(gnus-info-find-node url))
(t (error "Can't parse %s" url))))
(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 "("
(if (fboundp func)
(funcall func)
(message-position-on-field (caar args)))
- (insert (gnus-replace-in-string
- (mapconcat 'identity (reverse (cdar args)) ", ")
- "\r\n" "\n" t))
+ (insert (replace-regexp-in-string
+ "\r\n" "\n"
+ (mapconcat 'identity (reverse (cdar args)) ", ") nil t))
(setq args (cdr args)))
(if subject
(message-goto-body)
(defvar gnus-prev-page-map
(let ((map (make-sparse-keymap)))
- (define-key map gnus-mouse-2 'gnus-button-prev-page)
+ (define-key map [mouse-2] 'gnus-button-prev-page)
(define-key map "\r" 'gnus-button-prev-page)
map))
(defvar gnus-next-page-map
(let ((map (make-sparse-keymap)))
- (define-key map gnus-mouse-2 'gnus-button-next-page)
+ (define-key map [mouse-2] 'gnus-button-next-page)
(define-key map "\r" 'gnus-button-next-page)
map))
(defvar gnus-mime-security-button-map
(let ((map (make-sparse-keymap)))
- (define-key map gnus-mouse-2 'gnus-article-push-button)
- (define-key map gnus-down-mouse-3 'gnus-mime-security-button-menu)
+ (define-key map [mouse-2] 'gnus-article-push-button)
+ (define-key map [down-mouse-3] 'gnus-mime-security-button-menu)
(dolist (c gnus-mime-security-button-commands)
(define-key map (cadr c) (car c)))
map))
:button-keymap gnus-mime-security-button-map
:help-echo
(lambda (_widget)
- ;; Needed to properly clear the message due to a bug in
- ;; wid-edit (XEmacs only).
- (when (boundp 'help-echo-owns-message)
- (setq help-echo-owns-message t))
(format
"%S: show detail; %S: more options"
- (aref gnus-mouse-2 0)
- (aref gnus-down-mouse-3 0))))))
+ 'mouse-2
+ 'down-mouse-3)))))
(defun gnus-mime-display-security (handle)
(save-restriction
(interactive)
(gnus-mime-security-run-function 'mm-pipe-part))
-(gnus-ems-redefine)
-
(provide 'gnus-art)
(run-hooks 'gnus-art-load-hook)