* dgnushack.el (dgnushack-compile-file): New function.

[gnus] / lisp / gnus-xmas.el

diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el
index 3d7dd0c..598e09a 100644 (file)
--- a/lisp/gnus-xmas.el
+++ b/lisp/gnus-xmas.el
@@ -1,7 +1,6 @@
 ;;; gnus-xmas.el --- Gnus functions for XEmacs
 
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;;   2005, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -19,9 +18,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -107,16 +104,6 @@ Possibly the `etc' directory has not been installed.")))
 (defvar gnus-agent-summary-mode)
 (defvar gnus-draft-mode)
 
-(defun gnus-xmas-highlight-selected-summary ()
-  ;; Highlight selected article in summary buffer
-  (when gnus-summary-selected-face
-    (when gnus-newsgroup-selected-overlay
-      (delete-extent gnus-newsgroup-selected-overlay))
-    (setq gnus-newsgroup-selected-overlay
-         (make-extent (point-at-bol) (point-at-eol)))
-    (set-extent-face gnus-newsgroup-selected-overlay
-                    gnus-summary-selected-face)))
-
 (defcustom gnus-xmas-force-redisplay nil
   "*If non-nil, force a redisplay before recentering the summary buffer.
 This is ugly, but it works around a bug in `window-displayed-height'."
@@ -224,6 +211,10 @@ call it with the value of the `gnus-data' text property."
                 (delete-extent extent)
                 nil)))
 
+(defun gnus-xmas-overlays-at (pos)
+  "Return a list of the extents that contain the character at POS."
+  (mapcar-extents #'identity nil nil pos (1+ pos)))
+
 (defun gnus-xmas-overlays-in (beg end)
   "Return a list of the extents that overlap the region BEG ... END."
   (mapcar-extents #'identity nil nil beg end))
@@ -412,6 +403,7 @@ then we display only bindings that start with that prefix."
 FRONT-ADVANCE and REAR-ADVANCE are ignored."
       (make-extent beg end buffer)))
 
+  (defalias 'gnus-copy-overlay 'copy-extent)
   (defalias 'gnus-delete-overlay 'delete-extent)
   (defalias 'gnus-overlay-get 'extent-property)
   (defalias 'gnus-overlay-put 'set-extent-property)
@@ -419,6 +411,7 @@ FRONT-ADVANCE and REAR-ADVANCE are ignored."
   (defalias 'gnus-overlay-buffer 'extent-object)
   (defalias 'gnus-overlay-start 'extent-start-position)
   (defalias 'gnus-overlay-end 'extent-end-position)
+  (defalias 'gnus-overlays-at 'gnus-xmas-overlays-at)
   (defalias 'gnus-overlays-in 'gnus-xmas-overlays-in)
   (defalias 'gnus-kill-all-overlays 'gnus-xmas-kill-all-overlays)
   (defalias 'gnus-extent-detached-p 'extent-detached-p)
@@ -428,28 +421,22 @@ FRONT-ADVANCE and REAR-ADVANCE are ignored."
   (defalias 'gnus-window-edges 'window-pixel-edges)
   (defalias 'gnus-assq-delete-all 'gnus-xmas-assq-delete-all)
 
+  (unless (fboundp 'member-ignore-case)
+    (defun member-ignore-case (elt list)
+      (while (and list
+                 (or (not (stringp (car list)))
+                     (not (string= (downcase elt) (downcase (car list))))))
+       (setq list (cdr list)))
+      list))
+
   (unless (boundp 'standard-display-table)
     (setq standard-display-table nil))
 
   (defvar gnus-mouse-face-prop 'highlight)
 
-  (defun gnus-byte-code (func)
-    "Return a form that can be `eval'ed based on FUNC."
-    (let ((fval (indirect-function func)))
-      (if (compiled-function-p fval)
-         (list 'funcall fval)
-       (cons 'progn (cdr (cdr fval))))))
-
   (unless (fboundp 'match-string-no-properties)
     (defalias 'match-string-no-properties 'match-string))
 
-  (defalias 'gnus-x-color-values
-       (if (fboundp 'x-color-values)
-           'x-color-values
-         (lambda (color)
-           (color-instance-rgb-components
-            (make-color-instance color)))))
-
   (unless (fboundp 'char-width)
     (defalias 'char-width (lambda (ch) 1))))
 
@@ -526,8 +513,7 @@ FRONT-ADVANCE and REAR-ADVANCE are ignored."
       (while (not (eobp))
        (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
                             ?\ ))
-       (forward-line 1))
-      (setq gnus-simple-splash nil))
+       (forward-line 1)))
     (goto-char (point-min))
     (let* ((pheight (+ 20 (count-lines (point-min) (point-max))))
           (wheight (window-height))
@@ -761,11 +747,6 @@ XEmacs compatibility workaround."
       nil
     (mail-strip-quoted-names address)))
 
-(defun gnus-xmas-call-region (command &rest args)
-  (apply
-   'call-process-region (point-min) (point-max) command t '(t nil) nil
-   args))
-
 (defvar gnus-xmas-modeline-left-extent
   (let ((ext (copy-extent modeline-buffer-id-left-extent)))
     ext))
@@ -812,10 +793,6 @@ XEmacs compatibility workaround."
         (cons gnus-xmas-modeline-left-extent (substring line 0 chop)))
        (cons gnus-xmas-modeline-right-extent (substring line chop)))))))
 
-(defun gnus-xmas-splash ()
-  (when (eq (device-type) 'x)
-    (gnus-splash)))
-
 (defun gnus-xmas-annotation-in-region-p (b e)
   (or (map-extents (lambda (e u) t) nil b e nil nil 'mm t)
       (if (= b e)