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 (setq file (liece-locate-icon-file "liece-pointer.xbm"))
 247                  (list (vector 'xbm :file file)))
 248              '([string :data "Liece:"]))))))
 249     (set-glyph-face glyph 'modeline-buffer-id)
 250     glyph))
 251
 252 (defun liece-xemacs-mode-line-buffer-identification (line)
 253   "Decorate 1st element of `mode-line-buffer-identification' LINE.
 254 Modify whole identification by side effect."
 255   (let ((id (car line)) chop)
 256     (if (and (stringp id) (string-match "^Liece:" id))
 257         (progn
 258           (setq chop (match-end 0))
 259           (nconc
 260            (list
 261             (let ((glyph (liece-xemacs-modeline-glyph)))
 262               (if glyph
 263                   (cons liece-xemacs-modeline-left-extent glyph)
 264                 (cons liece-xemacs-modeline-left-extent
 265                       (substring id 0 chop))))
 266             (cons liece-xemacs-modeline-right-extent
 267                   (substring id chop)))
 268            (cdr line)))
 269       line)))
 270
 271 (defun liece-xemacs-suppress-modeline-format ()
 272   "Remove unnecessary information from `modeline-format'."
 273   (setq modeline-format
 274         (remrassq 'modeline-modified
 275                   (delq 'modeline-multibyte-status
 276                         (copy-sequence mode-line-format)))))
 277
 278 ;;; @ menus
 279 ;;;
 280 (defun liece-xemacs-nick-popup-menu (widget &optional event)
 281   "Trigger function for popup menu."
 282   (let ((pos (widget-event-point event)))
 283     (when pos
 284       (goto-char pos)
 285       (if (eq major-mode 'liece-nick-mode)
 286           (liece-nick-update-region))
 287       (let ((menu (cdr liece-nick-popup-menu)))
 288         (setq menu (nconc (list "IRCHAT" ; title: not displayed
 289                                 "     IRC commands"
 290                                 "--:shadowDoubleEtchedOut")
 291                           (mapcar (lambda (spec)
 292                                     (if (stringp spec)
 293                                         "--:shadowEtchedOut"
 294                                       spec))
 295                                   menu)))
 296         (let (popup-menu-titles)
 297           (popup-menu menu))))))
 298
 299 (fset 'liece-nick-popup-menu 'liece-xemacs-nick-popup-menu)
 300
 301 ;;; @ nick buffer decoration
 302 ;;;
 303 (defun liece-xemacs-create-nick-glyph (file &optional string)
 304   "Return a glyph of nick indicator from FILE or STRING."
 305   (or
 306    (cdr-safe (assoc file liece-glyph-cache))
 307    (let ((glyph
 308           (make-glyph
 309            (nconc
 310             (if (and (featurep 'xpm)
 311                      (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                        (list (vector 'xface :data str)
 444                              (vector 'string :data str))))
 445           (when glyph
 446             (push (cons nick glyph) liece-glyph-cache)
 447             (set-glyph-face glyph 'default)))
 448         (set-buffer buffer)
 449         (goto-char (point-max))
 450         (when glyph
 451           (set-extent-end-glyph (make-extent (point) (point)) glyph))))))
 452
 453 ;;; @ startup splash
 454 ;;;
 455 (eval-when-compile
 456   (defvar filename)
 457   (setq load-path
 458         `(,(if (and (boundp 'filename)
 459                     (stringp filename)
 460                     (file-exists-p filename))
 461                (file-name-directory filename)
 462              default-directory)
 463           ,@load-path)))
 464
 465 (when (featurep 'xpm)
 466   (eval-when-compile
 467     (defmacro liece-xemacs-logo ()
 468       (let ((logo "liece.xpm")
 469             (dir (if (and (boundp 'filename)
 470                           (stringp filename)
 471                           (file-exists-p filename))
 472                      (file-name-directory filename)
 473                    default-directory)))
 474         (setq logo (expand-file-name logo dir))
 475         (if (file-exists-p logo)
 476             (let ((buffer (generate-new-buffer " *liece-logo*"))
 477                   (coding-system-for-read (quote binary))
 478                   buffer-file-format format-alist
 479                   insert-file-contents-post-hook
 480                   insert-file-contents-pre-hook)
 481               (prog1
 482                   (save-excursion
 483                     (set-buffer buffer)
 484                     (insert-file-contents logo)
 485                     (buffer-string))
 486                 (kill-buffer buffer)))
 487           (progn
 488             (byte-compile-warn
 489              "Warning: file \"%s\" not found." logo)
 490             (sit-for 2)
 491             nil))))))
 492
 493 (defconst liece-xemacs-logo
 494   (when (featurep 'xpm)
 495     (liece-xemacs-logo)))
 496
 497 (defun liece-xemacs-splash-at-point (&optional height)
 498   "Display splash logo in HEIGHT."
 499   (or (bolp) (insert "\n"))
 500   (let ((bow (point))
 501         (glyph (make-glyph
 502                 (list (vector 'xpm :data liece-xemacs-logo)
 503                       [nothing])))
 504         (lh (/ (window-pixel-height) (window-height)))
 505         (lw (/ (window-pixel-width) (window-width)))
 506         (liece-insert-environment-version nil)
 507         bov)
 508
 509     (insert-char ?\n (max 0 (/ (- (or height (window-height))
 510                                   (/ (glyph-height glyph) lh))
 511                                2)))
 512     (insert-char ?\  (max 0 (/ (- (window-width)
 513                                   (/ (glyph-width glyph) lw))
 514                                2)))
 515     (set-extent-end-glyph
 516      (make-extent (point) (point))
 517      glyph)
 518     (insert "\n")
 519     (insert-char ?\  (max 0 (/ (- (window-width) (length (liece-version))) 2)))
 520     (setq bov (point))
 521     (insert (liece-version))
 522     (and (find-face 'bold-italic)
 523          (put-text-property bov (point) 'face 'bold-italic))
 524     (goto-char bow)
 525     (set-window-start (get-buffer-window (current-buffer)) (point))
 526     (redisplay-frame)))
 527
 528 (defun liece-xemacs-splash (&optional arg)
 529   "Display splash logo interactively.
 530 If ARG is given, don't hide splash buffer."
 531   (interactive "P")
 532   (and liece-xemacs-logo
 533        (let ((frame (selected-frame))
 534              config buffer
 535              (liece-insert-environment-version nil))
 536          (and frame
 537               (unwind-protect
 538                   (progn
 539                     (setq config (current-window-configuration))
 540                     (setq buffer (generate-new-buffer
 541                                   (concat (if arg "*" " *")
 542                                           (liece-version) "*")))
 543                     (switch-to-buffer buffer)
 544                     (delete-other-windows)
 545                     (liece-xemacs-splash-at-point)
 546                     (set-buffer-modified-p nil)
 547                     (or arg (sleep-for 2)))
 548                 (unless arg
 549                   (kill-buffer buffer)
 550                   (set-window-configuration config)
 551                   (redisplay-frame frame)))))))
 552
 553 (unless (or liece-inhibit-startup-message
 554             (eq 'stream (device-type)))
 555   (liece-xemacs-splash))
 556
 557 ;;; @ unread mark
 558 ;;;
 559 (defun liece-xemacs-unread-mark (chnl)
 560   (if liece-display-unread-mark
 561       (with-current-buffer liece-channel-list-buffer
 562         (let* ((buffer-read-only nil)
 563                (file (liece-locate-icon-file liece-xemacs-unread-icon))
 564                (glyph
 565                 (make-glyph
 566                  (nconc (if (and (featurep 'xpm) file)
 567                             (list (vector 'xpm :file file)))
 568                         (list (vector 'string
 569                                       :data liece-channel-unread-character)))))
 570                ext)
 571           (goto-char (point-min))
 572           (when (re-search-forward (concat "^ ?[0-9]+: " chnl "$") nil t)
 573             (goto-char (match-end 0))
 574             (insert " ")
 575             (setq ext (make-extent (match-end 0) (1+ (match-end 0))))
 576             (set-extent-end-glyph ext glyph))))))
 577
 578 (defun liece-xemacs-read-mark (chnl)
 579   (if liece-display-unread-mark
 580       (with-current-buffer liece-channel-list-buffer
 581         (let ((buffer-read-only nil))
 582           (goto-char (point-min))
 583           (when (re-search-forward (concat "^ ?[0-9]+: " chnl " $") nil t)
 584             (goto-char (1- (match-end 0)))
 585             (delete-char 1))))))
 586
 587 (defun liece-xemacs-redisplay-unread-mark ()
 588   (if liece-display-unread-mark
 589       (dolist (chnl liece-channel-unread-list)
 590         (liece-xemacs-unread-mark chnl))))
 591
 592 \f
 593 ;;; @ emulation functions
 594 ;;;
 595 (defun liece-xemacs-map-extents (function)
 596   "Map FUNCTION over the extents which overlap the current buffer."
 597   (map-extents (lambda (extent ignore)
 598                  (if (overlayp extent) (funcall function extent)))))
 599
 600 (defun liece-xemacs-kill-all-overlays ()
 601   "Delete all extents in the current buffer."
 602   (liece-xemacs-map-extents #'delete-extent))
 603
 604 (defun liece-xemacs-overlays-at (pos)
 605   "Return a list of the overlays that contain position POS."
 606   (let ((ext (extent-at pos)))
 607     (and ext (overlayp ext) (list ext))))
 608
 609 (fset 'liece-mode-line-buffer-identification
 610       'liece-xemacs-mode-line-buffer-identification)
 611
 612 (fset 'liece-suppress-mode-line-format
 613       'liece-xemacs-suppress-modeline-format)
 614
 615 (fset 'liece-kill-all-overlays 'liece-xemacs-kill-all-overlays)
 616 (fset 'liece-map-overlays 'liece-xemacs-map-extents)
 617 (fset 'liece-locate-data-directory 'locate-data-directory)
 618
 619 (add-hook 'liece-nick-insert-hook 'liece-xemacs-glyph-nick-region)
 620 (add-hook 'liece-nick-insert-hook 'liece-xemacs-set-drop-functions)
 621
 622 (add-hook 'liece-nick-replace-hook 'liece-xemacs-glyph-nick-region)
 623 (add-hook 'liece-nick-replace-hook 'liece-xemacs-set-drop-functions)
 624
 625 (fset 'liece-redisplay-unread-mark 'liece-xemacs-redisplay-unread-mark)
 626 (add-hook 'liece-channel-unread-functions 'liece-xemacs-unread-mark)
 627 (add-hook 'liece-channel-read-functions 'liece-xemacs-read-mark)
 628
 629 (provide 'liece-xemacs)
 630
 631 ;;; liece-xemacs.el ends here
 632