X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-xemacs.el;h=5df81ba9253826bc1ab740b357db45bf9a3b0c25;hp=9a5cc6a59bdc866810e61645123dd9d6552a22b7;hb=05933e03db571db13ae01c9e35e7bb35b71ad25d;hpb=9f0f8e8f7c1fefd0ae6712872f9dcb78ae3ea11c diff --git a/lisp/riece-xemacs.el b/lisp/riece-xemacs.el index 9a5cc6a..5df81ba 100644 --- a/lisp/riece-xemacs.el +++ b/lisp/riece-xemacs.el @@ -39,22 +39,6 @@ (add-hook 'riece-user-list-mode-hook 'riece-xemacs-hide-modeline) (add-hook 'riece-channel-list-mode-hook 'riece-xemacs-hide-modeline) -(defun riece-xemacs-mode-line-buffer-identification (line) - "Decorate 1st element of `mode-line-buffer-identification' LINE. -Modify whole identification by side effect." - (let ((id (car line)) chop) - (if (and (stringp id) (string-match "^Riece:" id)) - (progn - (setq chop (match-end 0)) - (nconc - (list - (cons (copy-extent modeline-buffer-id-left-extent) - (substring id 0 chop)) - (cons (copy-extent modeline-buffer-id-right-extent) - (substring id chop))) - (cdr line))) - line))) - (defun riece-xemacs-simplify-modeline-format () "Remove unnecessary information from `modeline-format'." (setq modeline-format @@ -62,17 +46,10 @@ Modify whole identification by side effect." (delq 'modeline-multibyte-status (copy-sequence mode-line-format))))) -(defalias 'riece-mode-line-buffer-identification - 'riece-xemacs-mode-line-buffer-identification) - (defalias 'riece-simplify-mode-line-format 'riece-xemacs-simplify-modeline-format) -(defalias 'riece-set-case-syntax-pair - 'put-case-table-pair) - -;;; stolen (and renamed) from gnus-ems.el. - +;;; stolen (and renamed) from gnus-xmas.el. ;;; In GNU Emacs, user can intercept whole mouse tracking events by ;;; assigning [mouse-X]. In XEmacs, however, which causes different ;;; effect, that is, the command assigned to [mouse-X] only catches @@ -83,9 +60,82 @@ Modify whole identification by side effect." ;;; semi-def.el. (defun riece-popup-menu-popup (menu event) (let ((response (get-popup-menu-response menu event))) - (set-buffer (event-buffer event)) - (goto-char (event-point event)) - (funcall (event-function response) (event-object response)))) + (if response + (funcall (event-function response) (event-object response))))) + +(defalias 'riece-event-buffer 'event-buffer) +(defalias 'riece-event-point 'event-point) + +;;; stolen (and renamed) from gnus-xmas.el. +(defalias 'riece-region-active-p 'region-active-p) + +(defalias 'riece-make-overlay 'make-extent) +(defalias 'riece-overlay-put 'set-extent-property) +(defalias 'riece-overlay-start 'extent-start-position) +(defalias 'riece-overlay-buffer 'extent-buffer) + +(defun riece-overlays-in (start end) + (extent-list (current-buffer) start end)) + +(defalias 'riece-delete-overlay 'delete-extent) + +(defun riece-kill-all-overlays () + "Delete all extents in the current buffer." + (map-extents (lambda (extent ignore) + (delete-extent extent) + nil))) + +;;; stolen (and renamed) from nnheaderxm.el. +(defun riece-xemacs-generate-timer-name (&optional prefix) + (let ((counter '(0))) + (format "%s-%d" + (or prefix + "riece-xemacs-timer") + (prog1 (car counter) + (setcar counter (1+ (car counter))))))) + +(defun riece-run-at-time (time repeat function &rest args) + (let ((name (riece-xemacs-generate-timer-name "riece-run-at-time"))) + (start-itimer + name + `(lambda () + (,function ,@args)) + (or time (current-time)) repeat) + name)) + +(defun riece-run-with-idle-timer (time repeat function &rest args) + (let ((name (riece-xemacs-generate-timer-name "riece-run-with-idle-timer"))) + (start-itimer + name + `(lambda () + (,function ,@args)) + time (if repeat 1) t) + name)) + +(defalias 'riece-cancel-timer 'delete-itimer) + +(defun riece-match-string-no-properties (number &optional string) + (format "%s" (match-string number string))) + +(defun riece-propertize-modeline-string (string &rest properties) + (let ((extent (make-extent nil nil))) + (set-extent-properties extent properties) + (cons extent string))) + +(defalias 'riece-normalize-modeline-string 'identity) + +(defalias 'riece-facep 'find-face) + +(defun riece-put-text-property-nonsticky (start end prop value + &optional object) + (add-text-properties start end (list prop value 'start-open t 'end-open t) + object)) + +(defun riece-recent-messages (n) + "Return N most recent messages, most recent first. +If N is nil, all messages will be returned." + (with-output-to-string + (print-recent-messages n))) (provide 'riece-xemacs)