lisp/liece-xemacs.el

   1 ;;; liece-xemacs.el --- XEmacs specific routines.
   2 ;; Copyright (C) 1998-2000 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Revised: 1999-08-22
   7 ;; Keywords: emulation
   8
   9 ;; This file is part of Liece.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31
  32 (eval-when-compile
  33   (require 'liece-inlines)
  34   (require 'liece-misc)
  35   (require 'liece-commands))
  36
  37 (autoload 'liece-command-dcc-send "liece-dcc")
  38 (defvar liece-nick-popup-menu)
  39
  40 (defgroup liece-toolbar nil
  41   "Toolbar of your XEmacs"
  42   :tag "Toolbar"
  43   :group 'liece)
  44
  45 (defgroup liece-toolbar-icons nil
  46   "Toolbar Icons of your XEmacs"
  47   :tag "Toolbar Icons"
  48   :prefix "liece-toolbar-"
  49   :group 'liece)
  50
  51 (defmacro liece-xemacs-icon-path (file)
  52   "Search icon FILE and return absolete path of the file."
  53   `(or (and liece-icon-directory
  54             (expand-file-name ,file liece-icon-directory))
  55        (let ((path (liece-find-path ,file "icons")))
  56          (when path
  57            (setq liece-icon-directory
  58                  (file-name-directory path)))
  59          path)))
  60
  61 (define-widget 'liece-toolbar-icon 'list
  62   "Edit toolbar spec entries"
  63   :match (lambda (widget value)
  64            (valid-plist-p value))
  65   :convert-widget 'liece-toolbar-icon-convert)
  66
  67 (eval-and-compile
  68   (defconst liece-toolbar-icon-states
  69     '(:up :down :disabled :cap-up :cap-down :cap-disabled)
  70     "toolbar event states")
  71
  72   (defun liece-toolbar-icon-convert-1 (state)
  73     (list 'group :inline t :format "%t: %v"
  74           :tag (capitalize (substring (symbol-name state) 1))
  75           (list 'const :format "" :value state
  76                 (list 'radio '(const :tag "none" nil) 'file)))))
  77
  78 (defun liece-toolbar-icon-convert (widget)
  79   "Widget converter of the WIDGET `liece-toolbar-icon'."
  80   (apply #'widget-put widget :args
  81          (eval-when-compile
  82            (mapcar #'liece-toolbar-icon-convert-1
  83                    liece-toolbar-icon-states)))
  84   widget)
  85
  86 (defcustom liece-use-toolbar (if (featurep 'toolbar)
  87                                  'default-toolbar
  88                                nil)
  89   "*If nil, do not use a toolbar.
  90 If it is non-nil, it must be a toolbar.  The five valid values are
  91 `default-toolbar', `top-toolbar', `bottom-toolbar',
  92 `right-toolbar', and `left-toolbar'."
  93   :type '(choice (const default-toolbar)
  94                  (const top-toolbar) (const bottom-toolbar)
  95                  (const left-toolbar) (const right-toolbar)
  96                  (const :tag "no toolbar" nil))
  97   :group 'liece-toolbar)
  98
  99 (defcustom liece-toolbar-back-icon '(:up "back.xpm")
 100   "Back button."
 101   :type 'liece-toolbar-icon
 102   :group 'liece-toolbar-icons)
 103
 104 (defcustom liece-toolbar-forward-icon '(:up "forward.xpm")
 105   "Forward button."
 106   :type 'liece-toolbar-icon
 107   :group 'liece-toolbar-icons)
 108
 109 (defcustom liece-toolbar-reload-icon '(:up "reload.xpm")
 110   "Reload button."
 111   :type 'liece-toolbar-icon
 112   :group 'liece-toolbar-icons)
 113
 114 (defcustom liece-toolbar-home-icon '(:up "home.xpm")
 115   "Home button."
 116   :type 'liece-toolbar-icon
 117   :group 'liece-toolbar-icons)
 118
 119 (defcustom liece-toolbar-search-icon '(:up "search.xpm")
 120   "Search button."
 121   :type 'liece-toolbar-icon
 122   :group 'liece-toolbar-icons)
 123
 124 (defcustom liece-toolbar-location-icon '(:up "location.xpm")
 125   "Location button."
 126   :type 'liece-toolbar-icon
 127   :group 'liece-toolbar-icons)
 128
 129 (defcustom liece-toolbar-stop-icon '(:up "stop.xpm")
 130   "Stop button."
 131   :type 'liece-toolbar-icon
 132   :group 'liece-toolbar-icons)
 133
 134 (defcustom liece-xemacs-unread-icon "balloon.xpm"
 135   "Unread icon."
 136   :type 'file
 137   :group 'liece-look)
 138
 139 ;;; @ internal variables
 140 ;;;
 141 (defvar liece-glyph-cache nil)
 142 (defvar liece-toolbar-position (if (featurep 'toolbar)
 143                                    (default-toolbar-position)
 144                                  nil))
 145
 146 (defvar liece-toolbar-back-glyph nil)
 147 (defvar liece-toolbar-forward-glyph nil)
 148 (defvar liece-toolbar-reload-glyph nil)
 149 (defvar liece-toolbar-home-glyph nil)
 150 (defvar liece-toolbar-search-glyph nil)
 151 (defvar liece-toolbar-location-glyph nil)
 152 (defvar liece-toolbar-stop-glyph nil)
 153
 154 (defvar liece-toolbar-spec-list
 155   '([liece-toolbar-back-glyph
 156      liece-command-previous-channel t "Previous Channel"]
 157     [liece-toolbar-forward-glyph
 158      liece-command-next-channel t "Next Channel"]
 159     [liece-toolbar-reload-glyph
 160      liece-command-list t "List Channel"]
 161     [liece-toolbar-home-glyph
 162      liece-switch-to-channel-no-1 t "Go Home Channel"]
 163     [liece-toolbar-search-glyph
 164      liece-command-finger t "Finger"]
 165     [liece-toolbar-location-glyph
 166      liece-command-join t "Join Channel"]
 167     [liece-toolbar-stop-glyph
 168      liece-command-quit t "Quit IRC"]))
 169
 170 ;;; @ toolbar icons
 171 ;;;
 172 (defun liece-toolbar-icon-plist-get (spec prop)
 173   "Return absolete path of icon file which SPEC has PROP."
 174   (let ((icon (plist-get spec prop)))
 175     (if icon (liece-locate-icon-file icon))))
 176
 177 (defun liece-toolbar-map-button-list (plist)
 178   "Make toolbar icon list based on status PLIST."
 179   (apply #'toolbar-make-button-list
 180          (mapcar
 181           (lambda (prop)
 182             (liece-toolbar-icon-plist-get plist prop))
 183           liece-toolbar-icon-states)))
 184
 185 (defun liece-xemacs-setup-toolbar (bar &optional force)
 186   "Prepare icons of toolbar BAR.
 187 If optional argument FORCE is non-nil, always update toolbar."
 188   (let (icon plist)
 189     (set-default-toolbar-position liece-toolbar-position)
 190     (dolist (spec bar)
 191       (setq icon (aref spec 0)
 192             plist (symbol-value
 193                    (intern (concat
 194                             (substring (prin1-to-string icon) -5 0)
 195                             "icon"))))
 196       (when (or force
 197                 (not (symbol-value icon)))
 198         (set icon (liece-toolbar-map-button-list plist))))
 199     (run-hooks 'liece-xemacs-setup-toolbar-hook)))
 200
 201 ;;; @ modeline decoration
 202 ;;;
 203 (defun liece-xemacs-hide-modeline ()
 204   "Remove modeline from current window."
 205   (set-specifier has-modeline-p nil (current-buffer)))
 206
 207 (when (featurep 'scrollbar)
 208   (defun liece-xemacs-hide-scrollbars ()
 209     (static-cond
 210      ((boundp 'horizontal-scrollbar-visible-p)
 211       (set-specifier horizontal-scrollbar-visible-p nil (current-buffer)))
 212      ((boundp 'scrollbar-height)
 213       (set-specifier scrollbar-height 0 (current-buffer)))))
 214   (add-hook 'liece-nick-mode-hook 'liece-xemacs-hide-scrollbars)
 215   (add-hook 'liece-channel-list-mode-hook 'liece-xemacs-hide-scrollbars))
 216
 217 (add-hook 'liece-nick-mode-hook 'liece-xemacs-hide-modeline)
 218 (add-hook 'liece-channel-list-mode-hook 'liece-xemacs-hide-modeline)
 219
 220 (defvar liece-xemacs-modeline-left-extent
 221   (let ((ext (copy-extent modeline-buffer-id-left-extent)))
 222     ext))
 223
 224 (defvar liece-xemacs-modeline-right-extent
 225   (let ((ext (copy-extent modeline-buffer-id-right-extent)))
 226     ext))
 227
 228 (add-hook 'liece-command-mode-hook 'liece-setup-toolbar)
 229
 230 (defun liece-setup-toolbar ()
 231   "Prepare toolbar if wanted."
 232   (when liece-use-toolbar
 233     (liece-xemacs-setup-toolbar liece-toolbar-spec-list)
 234     (set-specifier (symbol-value liece-use-toolbar) liece-toolbar-spec-list
 235                    (current-buffer))))
 236
 237 (defun liece-xemacs-modeline-glyph ()
 238   "Return a glyph of modeline pointer."
 239   (let ((glyph
 240          (let (file)
 241            (make-glyph
 242             (nconc
 243              (if (setq file (liece-locate-icon-file
 244                              "liece-pointer.xpm"))
 245                  (list (vector 'xpm :file file)))
 246              (if (setq file (liece-locate-icon-file
 247                              "liece-pointer.xbm"))
 248                  (list (vector 'xbm :file file)))
 249              '([string :data "Liece:"]))))))
 250     (set-glyph-face glyph 'modeline-buffer-id)
 251     glyph))
 252
 253 (defun liece-xemacs-mode-line-buffer-identification (line)
 254   "Decorate 1st element of `mode-line-buffer-identification' LINE.
 255 Modify whole identification by side effect."
 256   (let ((id (car line)) chop)
 257     (if (and (stringp id) (string-match "^Liece:" id))
 258         (progn
 259           (setq chop (match-end 0))
 260           (nconc
 261            (list
 262             (let ((glyph (liece-xemacs-modeline-glyph)))
 263               (if glyph
 264                   (cons liece-xemacs-modeline-left-extent glyph)
 265                 (cons liece-xemacs-modeline-left-extent
 266                       (substring id 0 chop))))
 267             (cons liece-xemacs-modeline-right-extent
 268                   (substring id chop)))
 269            (cdr line)))
 270       line)))
 271
 272 (defun liece-xemacs-suppress-modeline-format ()
 273   "Remove unnecessary information from `modeline-format'."
 274   (setq modeline-format
 275         (remrassq 'modeline-modified
 276                   (delq 'modeline-multibyte-status
 277                         (copy-sequence mode-line-format)))))
 278
 279 ;;; @ menus
 280 ;;;
 281 (defun liece-xemacs-nick-popup-menu (widget &optional event)
 282   "Trigger function for popup menu."
 283   (let ((pos (widget-event-point event)))
 284     (when pos
 285       (goto-char pos)
 286       (if (eq major-mode 'liece-nick-mode)
 287           (liece-nick-update-region))
 288       (let ((menu (cdr liece-nick-popup-menu)))
 289         (setq menu (nconc (list "IRCHAT" ; title: not displayed
 290                                 "     IRC commands"
 291                                 "--:shadowDoubleEtchedOut")
 292                           (mapcar (lambda (spec)
 293                                     (if (stringp spec)
 294                                         "--:shadowEtchedOut"
 295                                       spec))
 296                                   menu)))
 297         (let (popup-menu-titles)
 298           (popup-menu menu))))))
 299
 300 (fset 'liece-nick-popup-menu 'liece-xemacs-nick-popup-menu)
 301
 302 ;;; @ nick buffer decoration
 303 ;;;
 304 (defun liece-xemacs-create-nick-glyph (file &optional string)
 305   "Return a glyph of nick indicator from FILE or STRING."
 306   (or
 307    (cdr-safe (assoc file liece-glyph-cache))
 308    (let ((glyph
 309           (make-glyph
 310            (nconc
 311             (if (setq file (liece-locate-icon-file file))
 312                 (list (vector 'xpm :file file)))
 313             (if string
 314                 (list (vector 'string :data string)))))))
 315      (push (cons file glyph) liece-glyph-cache)
 316      (set-glyph-face glyph 'default)
 317      glyph)))
 318
 319 (defun liece-xemacs-glyph-nick-region (start end)
 320   "Decorate nick buffer between START and END."
 321   (save-excursion
 322     (setq start (progn (goto-char start)(beginning-of-line)(point))
 323           end (progn (goto-char end)(beginning-of-line 2)(point)))
 324     (save-restriction
 325       (narrow-to-region start end)
 326       (let ((buffer-read-only nil)
 327             (inhibit-read-only t)
 328             (case-fold-search nil)
 329             mark file glyph ext ant)
 330         (map-extents
 331          (lambda (e void)
 332            (when (or
 333                   (extent-property
 334                    e 'liece-xemacs-glyph-nick-extent)
 335                   (extent-property
 336                    e 'liece-xemacs-glyph-nick-annotation))
 337              (delete-extent e)))
 338          (current-buffer) start end)
 339         (dolist (entry liece-nick-image-alist)
 340           (setq mark (car entry)
 341                 file (cdr entry)
 342                 glyph (liece-xemacs-create-nick-glyph
 343                        file (char-to-string mark)))
 344           (when glyph
 345             (goto-char start)
 346             (while (not (eobp))
 347               (when (eq (char-after) mark)
 348                 (mapcar 'delete-annotation
 349                         (annotations-at (1+ (point))))
 350                 (setq ext (make-extent (point) (1+ (point)))
 351                       ant (make-annotation glyph (1+ (point)) 'text))
 352                 (set-extent-property ext 'end-open t)
 353                 (set-extent-property ext 'start-open t)
 354                 (set-extent-property ext 'invisible t)
 355                 (set-extent-property ext 'intangible t)
 356                 (set-extent-property
 357                  ant 'liece-xemacs-glyph-nick-extent ext)
 358                 (set-extent-property
 359                  ext 'liece-xemacs-glyph-nick-annotation ant))
 360               (beginning-of-line 2))))))))
 361
 362 (defun liece-xemacs-set-drop-functions (start end)
 363   "Initialize drag and drop in DCC between START and END.
 364 This function needs window system independent drag and drop
 365 support (21.0 b39 or later)"
 366   (interactive "r")
 367   (liece-xemacs-set-drop-functions-buffer
 368    (current-buffer) start end)
 369   (goto-char end))
 370
 371 (defun liece-xemacs-set-drop-functions-buffer (&optional buffer start end)
 372   "Initialize BUFFER drag and drop DCC settings between START and END.
 373 This function needs window system independent drag and drop
 374 support (21.0 b39 or later)"
 375   (interactive)
 376   (when (and (featurep 'x) (featurep 'dragdrop))
 377     (save-excursion
 378       (when buffer
 379         (set-buffer buffer))
 380       (setq start (or start (point-min))
 381             end (or end (point-max)))
 382       (goto-char start)
 383       (setq start (line-beginning-position))
 384       (goto-char end)
 385       (setq end (line-beginning-position))
 386       (goto-char end)
 387       (when (not (eobp))
 388         (beginning-of-line 2)
 389         (setq end (point)))
 390       (save-restriction
 391         (narrow-to-region start end)
 392         (let (buffer-read-only case-fold-search)
 393           (map-extents
 394            (function
 395             (lambda (e void)
 396               (when (extent-property e 'liece-xemacs-drop-extent)
 397                 (delete-extent e))))
 398            buffer start end)
 399           (goto-char start)
 400           (let (st nd nick func)
 401             (while (not (eobp))
 402               (forward-char)
 403               (setq st (point)
 404                     nd (line-end-position)
 405                     nick (buffer-substring st nd))
 406               (mapcar 'delete-annotation (annotations-at nd))
 407               (setq func (intern (concat "liece-xemacs-drop-function-" nick)))
 408               (fset func
 409                     (list 'lambda (list 'object)
 410                           (list 'liece-xemacs-drop-function 'object nick)))
 411               (let ((ext (make-extent st nd)))
 412                 (set-extent-property ext 'liece-xemacs-drop-extent t)
 413                 (set-extent-property ext 'dragdrop-drop-functions (list func)))
 414               (beginning-of-line 2))))))))
 415
 416 (defun liece-xemacs-drop-function (object nick)
 417   "Drag and drop handler.
 418 Always two arguments are passed, OBJECT and NICK."
 419   (if (and (eq (car object) 'dragdrop_URL)
 420            (stringp (cdr object))
 421            (string-match "^[^:]*:\\(.*\\)" (cdr object)))
 422       (let ((filename (match-string 1 (cdr object))))
 423         (liece-command-dcc-send filename nick))))
 424
 425 (defadvice easy-menu-add-item
 426   (around liece-fix-menu-path-switch-buffer activate)
 427   "Advice for XEmacs 20.4 or earlier."
 428   (save-excursion
 429     (set-buffer liece-command-buffer)
 430     (add-menu-button
 431      (cons (car (ad-get-arg 0)) (ad-get-arg 1))
 432      (ad-get-arg 2) (ad-get-arg 3))))
 433
 434 (eval-and-compile
 435   (setq liece-x-face-insert-function
 436         (function liece-x-face-insert-with-xemacs))
 437
 438   (defun liece-x-face-insert-with-xemacs (buffer str nick)
 439     (save-excursion
 440       (let ((glyph (cdr-safe (assoc nick liece-glyph-cache))))
 441         (unless glyph
 442           (setq glyph (make-glyph
 443                        (cond
 444                         ((and (featurep 'xface)
 445                               (memq (console-type) '(x mswindows)))
 446                          `[xface :data ,str])
 447                         (t `[string :data ,str]))))
 448           (when glyph
 449             (push (cons nick glyph) liece-glyph-cache)
 450             (set-glyph-face glyph 'default)))
 451         (set-buffer buffer)
 452         (goto-char (point-max))
 453         (when glyph
 454           (set-extent-end-glyph (make-extent (point) (point)) glyph))))))
 455
 456 ;;; @ startup splash
 457 ;;;
 458 (eval-when-compile
 459   (defvar filename)
 460   (setq load-path
 461         `(,(if (and (boundp 'filename)
 462                     (stringp filename)
 463                     (file-exists-p filename))
 464                (file-name-directory filename)
 465              default-directory)
 466           ,@load-path)))
 467
 468 (when (featurep 'xpm)
 469   (eval-when-compile
 470     (defmacro liece-xemacs-logo ()
 471       (let ((logo "liece.xpm")
 472             (dir (if (and (boundp 'filename)
 473                           (stringp filename)
 474                           (file-exists-p filename))
 475                      (file-name-directory filename)
 476                    default-directory)))
 477         (setq logo (expand-file-name logo dir))
 478         (if (file-exists-p logo)
 479             (let ((buffer (generate-new-buffer " *liece-logo*"))
 480                   (coding-system-for-read (quote binary))
 481                   buffer-file-format format-alist
 482                   insert-file-contents-post-hook
 483                   insert-file-contents-pre-hook)
 484               (prog1
 485                   (save-excursion
 486                     (set-buffer buffer)
 487                     (insert-file-contents logo)
 488                     (buffer-string))
 489                 (kill-buffer buffer)))
 490           (progn
 491             (byte-compile-warn
 492              "Warning: file \"%s\" not found." logo)
 493             (sit-for 2)
 494             nil))))))
 495
 496 (defconst liece-xemacs-logo
 497   (when (featurep 'xpm)
 498     (liece-xemacs-logo)))
 499
 500 (defun liece-xemacs-splash-at-point (&optional height)
 501   "Display splash logo in HEIGHT."
 502   (or (bolp) (insert "\n"))
 503   (let ((bow (point))
 504         (glyph (make-glyph `[xpm :data ,liece-xemacs-logo]))
 505         (lh (/ (window-pixel-height) (window-height)))
 506         (lw (/ (window-pixel-width) (window-width)))
 507         (liece-insert-environment-version nil)
 508         bov)
 509
 510     (insert-char ?\n (max 0 (/ (- (or height (window-height))
 511                                   (/ (glyph-height glyph) lh))
 512                                2)))
 513     (insert-char ?\  (max 0 (/ (- (window-width)
 514                                   (/ (glyph-width glyph) lw))
 515                                2)))
 516     (when (and (featurep 'xpm) (memq (console-type) '(x mswindows)))
 517       (set-extent-end-glyph
 518        (make-extent (point) (point))
 519        glyph))
 520     (insert "\n")
 521     (insert-char ?\  (max 0 (/ (- (window-width) (length (liece-version))) 2)))
 522     (setq bov (point))
 523     (insert (liece-version))
 524     (and (find-face 'bold-italic)
 525          (put-text-property bov (point) 'face 'bold-italic))
 526     (goto-char bow)
 527     (set-window-start (get-buffer-window (current-buffer)) (point))
 528     (redisplay-frame)))
 529
 530 (defun liece-xemacs-splash (&optional arg)
 531   "Display splash logo interactively.
 532 If ARG is given, don't hide splash buffer."
 533   (interactive "P")
 534   (and liece-xemacs-logo
 535        (let ((frame (selected-frame))
 536              config buffer
 537              (liece-insert-environment-version nil))
 538          (and frame
 539               (unwind-protect
 540                   (progn
 541                     (setq config (current-window-configuration))
 542                     (switch-to-buffer
 543                      (setq buffer (generate-new-buffer
 544                                    (concat (if arg "*" " *")
 545                                            (liece-version) "*"))))
 546                     (delete-other-windows)
 547                     (liece-xemacs-splash-at-point)
 548                     (set-buffer-modified-p nil)
 549                     (or arg (sleep-for 2)))
 550                 (unless arg
 551                   (kill-buffer buffer)
 552                   (set-window-configuration config)
 553                   (redisplay-frame frame)))))))
 554
 555 (or (eq 'stream (device-type))
 556     (liece-xemacs-splash))
 557
 558 ;;; @ unread mark
 559 ;;;
 560 (defun liece-xemacs-unread-mark (chnl)
 561   (if liece-display-unread-mark
 562     (with-current-buffer liece-channel-list-buffer
 563       (let* ((buffer-read-only nil)
 564              (file (liece-xemacs-icon-path
 565                     liece-xemacs-unread-icon))
 566              (glyph (make-glyph (vector 'xpm ':file file)))
 567              ext)
 568         (goto-char (point-min))
 569         (when (re-search-forward (concat "^ ?[0-9]+: " chnl "$") nil t)
 570           (goto-char (match-end 0))
 571           (insert " ")
 572           (setq ext (make-extent (match-end 0) (1+ (match-end 0))))
 573           (set-extent-end-glyph ext glyph))))))
 574
 575 (defun liece-xemacs-read-mark (chnl)
 576   (if liece-display-unread-mark
 577     (with-current-buffer liece-channel-list-buffer
 578       (let ((buffer-read-only nil))
 579         (goto-char (point-min))
 580         (when (re-search-forward (concat "^ ?[0-9]+: " chnl " $") nil t)
 581           (goto-char (1- (match-end 0)))
 582           (delete-char 1))))))
 583
 584 (defun liece-xemacs-redisplay-unread-mark ()
 585   (if liece-display-unread-mark
 586     (let ((chnl))
 587       (dolist (chnl liece-channel-unread-list)
 588         (liece-xemacs-unread-mark chnl)))))
 589
 590 \f
 591 ;;; @ emulation functions
 592 ;;;
 593 (defun liece-xemacs-map-extents (function)
 594   "Map FUNCTION over the extents which overlap the current buffer."
 595   (map-extents (lambda (extent ignore)
 596                  (if (overlayp extent) (funcall function extent)))))
 597
 598 (defun liece-xemacs-kill-all-overlays ()
 599   "Delete all extents in the current buffer."
 600   (liece-xemacs-map-extents #'delete-extent))
 601
 602 (defun liece-xemacs-overlays-at (pos)
 603   "Return a list of the overlays that contain position POS."
 604   (let ((ext (extent-at pos)))
 605     (and ext (overlayp ext) (list ext))))
 606
 607 (fset 'liece-mode-line-buffer-identification
 608       'liece-xemacs-mode-line-buffer-identification)
 609
 610 (fset 'liece-suppress-mode-line-format
 611       'liece-xemacs-suppress-modeline-format)
 612
 613 (fset 'liece-kill-all-overlays 'liece-xemacs-kill-all-overlays)
 614 (fset 'liece-map-overlays 'liece-xemacs-map-extents)
 615 (fset 'liece-locate-data-directory 'locate-data-directory)
 616
 617 (add-hook 'liece-nick-insert-hook 'liece-xemacs-glyph-nick-region)
 618 (add-hook 'liece-nick-insert-hook 'liece-xemacs-set-drop-functions)
 619
 620 (add-hook 'liece-nick-replace-hook 'liece-xemacs-glyph-nick-region)
 621 (add-hook 'liece-nick-replace-hook 'liece-xemacs-set-drop-functions)
 622
 623 (if (and (featurep 'xpm)
 624          (memq (console-type) '(x gtk mswindows)))
 625     (progn
 626       (fset 'liece-redisplay-unread-mark 'liece-xemacs-redisplay-unread-mark)
 627       (add-hook 'liece-channel-unread-hook 'liece-xemacs-unread-mark)
 628       (add-hook 'liece-channel-read-hook 'liece-xemacs-read-mark))
 629   (fset 'liece-redisplay-unread-mark 'liece-emacs-redisplay-unread-mark)
 630   (add-hook 'liece-channel-unread-hook 'liece-emacs-unread-mark)
 631   (add-hook 'liece-channel-read-hook 'liece-emacs-read-mark))
 632
 633 (provide 'liece-xemacs)
 634
 635 ;;; liece-xemacs.el ends here
 636