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 (and (featurep 'xpm)
 244                       (setq file (liece-locate-icon-file "liece-pointer.xpm")))
 245                  (list (vector 'xpm :file file)))
 246              (if (and (featurep 'xbm)
 247                       (setq file (liece-locate-icon-file "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 (and (featurep 'xpm)
 312                      (setq file (liece-locate-icon-file file)))
 313                 (list (vector 'xpm :file file)))
 314             (if string
 315                 (list (vector 'string :data string)))))))
 316      (push (cons file glyph) liece-glyph-cache)
 317      (set-glyph-face glyph 'default)
 318      glyph)))
 319
 320 (defun liece-xemacs-glyph-nick-region (start end)
 321   "Decorate nick buffer between START and END."
 322   (save-excursion
 323     (setq start (progn (goto-char start)(beginning-of-line)(point))
 324           end (progn (goto-char end)(beginning-of-line 2)(point)))
 325     (save-restriction
 326       (narrow-to-region start end)
 327       (let ((buffer-read-only nil)
 328             (inhibit-read-only t)
 329             (case-fold-search nil)
 330             mark file glyph ext ant)
 331         (map-extents
 332          (lambda (e void)
 333            (when (or
 334                   (extent-property
 335                    e 'liece-xemacs-glyph-nick-extent)
 336                   (extent-property
 337                    e 'liece-xemacs-glyph-nick-annotation))
 338              (delete-extent e)))
 339          (current-buffer) start end)
 340         (dolist (entry liece-nick-image-alist)
 341           (setq mark (car entry)
 342                 file (cdr entry)
 343                 glyph (liece-xemacs-create-nick-glyph
 344                        file (char-to-string mark)))
 345           (when glyph
 346             (goto-char start)
 347             (while (not (eobp))
 348               (when (eq (char-after) mark)
 349                 (mapcar 'delete-annotation
 350                         (annotations-at (1+ (point))))
 351                 (setq ext (make-extent (point) (1+ (point)))
 352                       ant (make-annotation glyph (1+ (point)) 'text))
 353                 (set-extent-property ext 'end-open t)
 354                 (set-extent-property ext 'start-open t)
 355                 (set-extent-property ext 'invisible t)
 356                 (set-extent-property ext 'intangible t)
 357                 (set-extent-property
 358                  ant 'liece-xemacs-glyph-nick-extent ext)
 359                 (set-extent-property
 360                  ext 'liece-xemacs-glyph-nick-annotation ant))
 361               (beginning-of-line 2))))))))
 362
 363 (defun liece-xemacs-set-drop-functions (start end)
 364   "Initialize drag and drop in DCC between START and END.
 365 This function needs window system independent drag and drop
 366 support (21.0 b39 or later)"
 367   (interactive "r")
 368   (liece-xemacs-set-drop-functions-buffer
 369    (current-buffer) start end)
 370   (goto-char end))
 371
 372 (defun liece-xemacs-set-drop-functions-buffer (&optional buffer start end)
 373   "Initialize BUFFER drag and drop DCC settings between START and END.
 374 This function needs window system independent drag and drop
 375 support (21.0 b39 or later)"
 376   (interactive)
 377   (when (and (featurep 'x) (featurep 'dragdrop))
 378     (save-excursion
 379       (when buffer
 380         (set-buffer buffer))
 381       (setq start (or start (point-min))
 382             end (or end (point-max)))
 383       (goto-char start)
 384       (setq start (line-beginning-position))
 385       (goto-char end)
 386       (setq end (line-beginning-position))
 387       (goto-char end)
 388       (when (not (eobp))
 389         (beginning-of-line 2)
 390         (setq end (point)))
 391       (save-restriction
 392         (narrow-to-region start end)
 393         (let (buffer-read-only case-fold-search)
 394           (map-extents
 395            (function
 396             (lambda (e void)
 397               (when (extent-property e 'liece-xemacs-drop-extent)
 398                 (delete-extent e))))
 399            buffer start end)
 400           (goto-char start)
 401           (let (st nd nick func)
 402             (while (not (eobp))
 403               (forward-char)
 404               (setq st (point)
 405                     nd (line-end-position)
 406                     nick (buffer-substring st nd))
 407               (mapcar 'delete-annotation (annotations-at nd))
 408               (setq func (intern (concat "liece-xemacs-drop-function-" nick)))
 409               (fset func
 410                     (list 'lambda (list 'object)
 411                           (list 'liece-xemacs-drop-function 'object nick)))
 412               (let ((ext (make-extent st nd)))
 413                 (set-extent-property ext 'liece-xemacs-drop-extent t)
 414                 (set-extent-property ext 'dragdrop-drop-functions (list func)))
 415               (beginning-of-line 2))))))))
 416
 417 (defun liece-xemacs-drop-function (object nick)
 418   "Drag and drop handler.
 419 Always two arguments are passed, OBJECT and NICK."
 420   (if (and (eq (car object) 'dragdrop_URL)
 421            (stringp (cdr object))
 422            (string-match "^[^:]*:\\(.*\\)" (cdr object)))
 423       (let ((filename (match-string 1 (cdr object))))
 424         (liece-command-dcc-send filename nick))))
 425
 426 (defadvice easy-menu-add-item
 427   (around liece-fix-menu-path-switch-buffer activate)
 428   "Advice for XEmacs 20.4 or earlier."
 429   (save-excursion
 430     (set-buffer liece-command-buffer)
 431     (add-menu-button
 432      (cons (car (ad-get-arg 0)) (ad-get-arg 1))
 433      (ad-get-arg 2) (ad-get-arg 3))))
 434
 435 (eval-and-compile
 436   (setq liece-x-face-insert-function
 437         (function liece-x-face-insert-with-xemacs))
 438
 439   (defun liece-x-face-insert-with-xemacs (buffer str nick)
 440     (save-excursion
 441       (let ((glyph (cdr-safe (assoc nick liece-glyph-cache))))
 442         (unless glyph
 443           (setq glyph (make-glyph
 444                        (list (vector 'xface :data str)
 445                              (vector 'string :data str))))
 446           (when glyph
 447             (push (cons nick glyph) liece-glyph-cache)
 448             (set-glyph-face glyph 'default)))
 449         (set-buffer buffer)
 450         (goto-char (point-max))
 451         (when glyph
 452           (set-extent-end-glyph (make-extent (point) (point)) glyph))))))
 453
 454 ;;; @ startup splash
 455 ;;;
 456 (eval-when-compile
 457   (defvar filename)
 458   (setq load-path
 459         `(,(if (and (boundp 'filename)
 460                     (stringp filename)
 461                     (file-exists-p filename))
 462                (file-name-directory filename)
 463              default-directory)
 464           ,@load-path)))
 465
 466 (when (featurep 'xpm)
 467   (eval-when-compile
 468     (defmacro liece-xemacs-logo ()
 469       (let ((logo "liece.xpm")
 470             (dir (if (and (boundp 'filename)
 471                           (stringp filename)
 472                           (file-exists-p filename))
 473                      (file-name-directory filename)
 474                    default-directory)))
 475         (setq logo (expand-file-name logo dir))
 476         (if (file-exists-p logo)
 477             (let ((buffer (generate-new-buffer " *liece-logo*"))
 478                   (coding-system-for-read (quote binary))
 479                   buffer-file-format format-alist
 480                   insert-file-contents-post-hook
 481                   insert-file-contents-pre-hook)
 482               (prog1
 483                   (save-excursion
 484                     (set-buffer buffer)
 485                     (insert-file-contents logo)
 486                     (buffer-string))
 487                 (kill-buffer buffer)))
 488           (progn
 489             (byte-compile-warn
 490              "Warning: file \"%s\" not found." logo)
 491             (sit-for 2)
 492             nil))))))
 493
 494 (defconst liece-xemacs-logo
 495   (when (featurep 'xpm)
 496     (liece-xemacs-logo)))
 497
 498 (defun liece-xemacs-splash-at-point (&optional height)
 499   "Display splash logo in HEIGHT."
 500   (or (bolp) (insert "\n"))
 501   (let ((bow (point))
 502         (glyph (make-glyph
 503                 (list (vector 'xpm :data liece-xemacs-logo)
 504                       [nothing])))
 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     (set-extent-end-glyph
 517      (make-extent (point) (point))
 518      glyph)
 519     (insert "\n")
 520     (insert-char ?\  (max 0 (/ (- (window-width) (length (liece-version))) 2)))
 521     (setq bov (point))
 522     (insert (liece-version))
 523     (and (find-face 'bold-italic)
 524          (put-text-property bov (point) 'face 'bold-italic))
 525     (goto-char bow)
 526     (set-window-start (get-buffer-window (current-buffer)) (point))
 527     (redisplay-frame)))
 528
 529 (defun liece-xemacs-splash (&optional arg)
 530   "Display splash logo interactively.
 531 If ARG is given, don't hide splash buffer."
 532   (interactive "P")
 533   (and liece-xemacs-logo
 534        (let ((frame (selected-frame))
 535              config buffer
 536              (liece-insert-environment-version nil))
 537          (and frame
 538               (unwind-protect
 539                   (progn
 540                     (setq config (current-window-configuration))
 541                     (setq buffer (generate-new-buffer
 542                                   (concat (if arg "*" " *")
 543                                           (liece-version) "*")))
 544                     (switch-to-buffer buffer)
 545                     (delete-other-windows)
 546                     (liece-xemacs-splash-at-point)
 547                     (set-buffer-modified-p nil)
 548                     (or arg (sleep-for 2)))
 549                 (unless arg
 550                   (kill-buffer buffer)
 551                   (set-window-configuration config)
 552                   (redisplay-frame frame)))))))
 553
 554 (unless (or liece-inhibit-startup-message
 555             (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-locate-icon-file liece-xemacs-unread-icon))
 565                (glyph
 566                 (make-glyph
 567                  (nconc (if (and (featurep 'xpm) file)
 568                             (list (vector 'xpm :file file)))
 569                         (list (vector 'string
 570                                       :data liece-channel-unread-character)))))
 571                ext)
 572           (goto-char (point-min))
 573           (when (re-search-forward (concat "^ ?[0-9]+: " chnl "$") nil t)
 574             (goto-char (match-end 0))
 575             (insert " ")
 576             (setq ext (make-extent (match-end 0) (1+ (match-end 0))))
 577             (set-extent-end-glyph ext glyph))))))
 578
 579 (defun liece-xemacs-read-mark (chnl)
 580   (if liece-display-unread-mark
 581       (with-current-buffer liece-channel-list-buffer
 582         (let ((buffer-read-only nil))
 583           (goto-char (point-min))
 584           (when (re-search-forward (concat "^ ?[0-9]+: " chnl " $") nil t)
 585             (goto-char (1- (match-end 0)))
 586             (delete-char 1))))))
 587
 588 (defun liece-xemacs-redisplay-unread-mark ()
 589   (if liece-display-unread-mark
 590       (dolist (chnl liece-channel-unread-list)
 591         (liece-xemacs-unread-mark chnl))))
 592
 593 \f
 594 ;;; @ emulation functions
 595 ;;;
 596 (defun liece-xemacs-map-extents (function)
 597   "Map FUNCTION over the extents which overlap the current buffer."
 598   (map-extents (lambda (extent ignore)
 599                  (if (overlayp extent) (funcall function extent)))))
 600
 601 (defun liece-xemacs-kill-all-overlays ()
 602   "Delete all extents in the current buffer."
 603   (liece-xemacs-map-extents #'delete-extent))
 604
 605 (defun liece-xemacs-overlays-at (pos)
 606   "Return a list of the overlays that contain position POS."
 607   (let ((ext (extent-at pos)))
 608     (and ext (overlayp ext) (list ext))))
 609
 610 (fset 'liece-mode-line-buffer-identification
 611       'liece-xemacs-mode-line-buffer-identification)
 612
 613 (fset 'liece-suppress-mode-line-format
 614       'liece-xemacs-suppress-modeline-format)
 615
 616 (fset 'liece-kill-all-overlays 'liece-xemacs-kill-all-overlays)
 617 (fset 'liece-map-overlays 'liece-xemacs-map-extents)
 618 (fset 'liece-locate-data-directory 'locate-data-directory)
 619
 620 (add-hook 'liece-nick-insert-hook 'liece-xemacs-glyph-nick-region)
 621 (add-hook 'liece-nick-insert-hook 'liece-xemacs-set-drop-functions)
 622
 623 (add-hook 'liece-nick-replace-hook 'liece-xemacs-glyph-nick-region)
 624 (add-hook 'liece-nick-replace-hook 'liece-xemacs-set-drop-functions)
 625
 626 (fset 'liece-redisplay-unread-mark 'liece-xemacs-redisplay-unread-mark)
 627 (add-hook 'liece-channel-unread-functions 'liece-xemacs-unread-mark)
 628 (add-hook 'liece-channel-read-functions 'liece-xemacs-read-mark)
 629
 630 (provide 'liece-xemacs)
 631
 632 ;;; liece-xemacs.el ends here
 633