Commit bf5825b5 authored by David Byers's avatar David Byers
Browse files

Bugfixar

parent 19bae601
Fri Jul 11 09:17:28 1997 David Byers <davby@ida.liu.se> Fri Jul 11 09:17:28 1997 David Byers <davby@ida.liu.se>
* compatibility.el: Tog bort popup-menu eftersom vissa Gnu Emacs
definierar en okompatibel variant av den hr funktionen. Vi
anvnder lyskom-do-popup-menu istllet.
* lyskom-buttons.el (lyskom-button-menu): Anvnd
lyskom-do-popup-menu.
* menus.el (lyskom-background-menu): Tog bort event-argumentet
frn anropet.
(lyskom-do-popup-menu): Ny funktion.
(lyskom-background-menu): Anvnd den.
* lyskom-rest.el (lyskom-w3-region): Ny funktion.
* lyskom-buttons.el (lyskom-button-menu): Tog bort
event-argumentet frn popup-menu.
* compatibility.el (next-text-property-bounds): Lade till igen
tack vare den elndiga danske faan.
* option-edit.el (lyskom-customize-send): Skriv ut listor mm med
quote.
* edit-text.el (kom-ispell-message): Requirea ispell.
* macros.el (define-widget): Wrappa med lyskom-widget-wrapper.
* compatibility.el (char-to-int): Function, not subst, and things * compatibility.el (char-to-int): Function, not subst, and things
work better. work better.
......
...@@ -208,6 +208,43 @@ of the lyskom-provide-* functions instead." ...@@ -208,6 +208,43 @@ of the lyskom-provide-* functions instead."
(lyskom-provide-function map-extents (&rest args)) (lyskom-provide-function map-extents (&rest args))
(lyskom-provide-function next-text-property-bounds
(count pos prop &optional object)
"Return the COUNTth bounded property region of property PROP after POS.
If COUNT is less than zero, search backwards. This returns a cons
\(START . END) of the COUNTth maximal region of text that begins after POS
\(starts before POS) and has a non-nil value for PROP. If there aren't
that many regions, nil is returned. OBJECT specifies the buffer or
string to search in."
(or object (setq object (current-buffer)))
(let ((begin (if (stringp object) 0 (point-min)))
(end (if (stringp object) (length object) (point-max))))
(catch 'hit-end
(if (> count 0)
(progn
(while (> count 0)
(if (>= pos end)
(throw 'hit-end nil)
(and (get-char-property pos prop object)
(setq pos (next-single-property-change pos prop
object end)))
(setq pos (next-single-property-change pos prop object end)))
(setq count (1- count)))
(and (< pos end)
(cons pos (next-single-property-change pos prop object end))))
(while (< count 0)
(if (<= pos begin)
(throw 'hit-end nil)
(and (get-char-property (1- pos) prop object)
(setq pos (previous-single-property-change pos prop
object begin)))
(setq pos (previous-single-property-change pos prop object
begin)))
(setq count (1+ count)))
(and (> pos begin)
(cons (previous-single-property-change pos prop object begin)
pos))))))
;;; ============================================================ ;;; ============================================================
;;; Character stuff ;;; Character stuff
...@@ -226,13 +263,6 @@ visible in the event's window." ...@@ -226,13 +263,6 @@ visible in the event's window."
(lyskom-provide-function event-glyph (e)) (lyskom-provide-function event-glyph (e))
(lyskom-provide-function popup-menu (menu-desc &optional event)
(let* ((result (x-popup-menu (or event t)
(list menu-desc)))
(command (car result)))
(if command
(apply (car command)
(cdr command)))))
(defun lyskom-get-buffer-window-list (buffer &optional minibuf frame) (defun lyskom-get-buffer-window-list (buffer &optional minibuf frame)
"Return windows currently displaying BUFFER, or nil if none. "Return windows currently displaying BUFFER, or nil if none.
......
...@@ -17,7 +17,7 @@ EMACS=emacs ...@@ -17,7 +17,7 @@ EMACS=emacs
# INFODIR is where documentation goes (if there is any) # INFODIR is where documentation goes (if there is any)
# ====================================================================== # ======================================================================
LISPDIR=/usr/gnu/share/emacs/site-list LISPDIR=/usr/gnu/share/emacs/site-lisp
INFODIR=/usr/gnu/info INFODIR=/usr/gnu/info
...@@ -100,7 +100,7 @@ lyskom.el: $(HEADER) $(SOURCES) ...@@ -100,7 +100,7 @@ lyskom.el: $(HEADER) $(SOURCES)
cat $(HEADER) $(SOURCES) > lyskom.el cat $(HEADER) $(SOURCES) > lyskom.el
install: all install: all
cp lykom.el lyskom.elc $(LISPDIR) cp lyskom.el lyskom.elc $(LISPDIR)
clean: clean:
$(RM) lyskom.el $(RM) lyskom.el
......
...@@ -420,6 +420,7 @@ Put this in lyskom-send-text-hook" ...@@ -420,6 +420,7 @@ Put this in lyskom-send-text-hook"
kom-ispell-dictionary is the dictionary to use to check spelling. kom-ispell-dictionary is the dictionary to use to check spelling.
Based on ispell-message." Based on ispell-message."
(interactive) (interactive)
(require 'ispell)
(let ((ispell-dictionary (or kom-ispell-dictionary ispell-dictionary)) (let ((ispell-dictionary (or kom-ispell-dictionary ispell-dictionary))
(kill-ispell (or (not (boundp 'ispell-dictionary)) (kill-ispell (or (not (boundp 'ispell-dictionary))
(not (string= kom-ispell-dictionary (not (string= kom-ispell-dictionary
...@@ -479,6 +480,7 @@ Based on ispell-message." ...@@ -479,6 +480,7 @@ Based on ispell-message."
(end-c (and (re-search-forward cite-regexp-end limit 'end) (end-c (and (re-search-forward cite-regexp-end limit 'end)
(match-beginning 0))) (match-beginning 0)))
(end-fwd (and (goto-char start) (end-fwd (and (goto-char start)
(boundp 'ispell-message-start-skip)
(re-search-forward ispell-message-start-skip (re-search-forward ispell-message-start-skip
limit 'end))) limit 'end)))
(end (or (and end-c end-fwd (min end-c end-fwd)) (end (or (and end-c end-fwd (min end-c end-fwd))
......
...@@ -92,7 +92,7 @@ is used instead of `load-path'." ...@@ -92,7 +92,7 @@ is used instead of `load-path'."
(have-wid-browse (lyskom-locate-library "wid-browse")) (have-wid-browse (lyskom-locate-library "wid-browse"))
(have-cus-edit (lyskom-locate-library "cus-edit")) (have-cus-edit (lyskom-locate-library "cus-edit"))
(have-cus-face (lyskom-locate-library "cus-face")) (have-cus-face (lyskom-locate-library "cus-face"))
(have-w3 (lyskom-locate-library "have-w3")) (have-w3 (lyskom-locate-library "w3"))
(fatal nil)) (fatal nil))
;; ;;
......
...@@ -114,7 +114,9 @@ on such functions see the documentation for lyskom-add-button-action." ...@@ -114,7 +114,9 @@ on such functions see the documentation for lyskom-add-button-action."
(or (and glyph (glyph-property glyph 'widget)) (or (and glyph (glyph-property glyph 'widget))
(widget-at pos)))) (widget-at pos))))
(parent (and widget (widget-get widget ':parent))) (parent (and widget (widget-get widget ':parent)))
(href (or (and widget (widget-get widget 'href)) (href (or (and widget (widget-get widget ':href))
(and parent (widget-get parent ':href))
(and widget (widget-get widget 'href))
(and parent (widget-get parent 'href))))) (and parent (widget-get parent 'href)))))
(cond (href (w3-widget-button-click event)) (cond (href (w3-widget-button-click event))
(t (lyskom-button-press pos))))) (t (lyskom-button-press pos)))))
...@@ -128,7 +130,9 @@ on such functions see the documentation for lyskom-add-button-action." ...@@ -128,7 +130,9 @@ on such functions see the documentation for lyskom-add-button-action."
(or (and glyph (glyph-property glyph 'widget)) (or (and glyph (glyph-property glyph 'widget))
(widget-at pos)))) (widget-at pos))))
(parent (and widget (widget-get widget ':parent))) (parent (and widget (widget-get widget ':parent)))
(href (or (and widget (widget-get widget 'href)) (href (or (and widget (widget-get widget ':href))
(and parent (widget-get parent ':href))
(and widget (widget-get widget 'href))
(and parent (widget-get parent 'href))))) (and parent (widget-get parent 'href)))))
(cond (href (w3-popup-menu event)) (cond (href (w3-popup-menu event))
((and pos (get-text-property pos 'lyskom-button-type)) ((and pos (get-text-property pos 'lyskom-button-type))
...@@ -196,7 +200,7 @@ on such functions see the documentation for lyskom-add-button-action." ...@@ -196,7 +200,7 @@ on such functions see the documentation for lyskom-add-button-action."
;; the GNU folks. /davidk ;; the GNU folks. /davidk
(let* ((menu (lyskom-make-button-menu title actl (let* ((menu (lyskom-make-button-menu title actl
buf arg text))) buf arg text)))
(popup-menu menu event)))))) (lyskom-do-popup-menu menu event))))))
......
...@@ -666,22 +666,34 @@ The position lyskom-last-viewed will always remain visible." ...@@ -666,22 +666,34 @@ The position lyskom-last-viewed will always remain visible."
2))) 2)))
))))))) )))))))
;;;
;;; Thanks to the stupid danish fool who wrote the widget package, we
;;; have to do it this way, because w3 uses widgets, and because
;;; widgets use overlays, and because overlays aren't copied between
;;; buffers. If the idiot danish flaming asshole had used text
;;; properties or something equally sensible instead, we could have
;;; managed without this shit.
;;;
;;; (Me, upset? Why would you think *that*?)
;;;
(defsubst lyskom-do-insert (string) (defsubst lyskom-do-insert (string)
;; (let ((start (point))) (let ((start (point)))
(insert string) (insert string)
;; (let ((bounds (next-text-property-bounds 1 (1- start) 'special-insert)) (let ((bounds (next-text-property-bounds 1 (max 1 (1- start))
;; (next (make-marker)) 'special-insert))
;; (fn nil)) (next (make-marker))
;; (while bounds (fn nil))
;; (set-marker next (cdr bounds)) (while bounds
;; (setq fn (get-text-property (car bounds) 'special-insert)) (set-marker next (cdr bounds))
;; (remove-text-properties (car bounds) (cdr bounds) (setq fn (get-text-property (car bounds) 'special-insert))
;; '(special-insert)) (remove-text-properties (car bounds) (cdr bounds)
;; (funcall fn (car bounds) (cdr bounds)) '(special-insert))
;; (setq start next) (funcall fn (car bounds) (cdr bounds))
;; (setq bounds (next-text-property-bounds 1 start (setq start next)
;; 'special-insert))))) (setq bounds (next-text-property-bounds 1 start
'special-insert)))))
) )
...@@ -1361,29 +1373,39 @@ Note that it is not allowed to use deferred insertions in the text." ...@@ -1361,29 +1373,39 @@ Note that it is not allowed to use deferred insertions in the text."
(kom-text-properties (lyskom-button-transform-text text)) (kom-text-properties (lyskom-button-transform-text text))
(t text)))) (t text))))
(defun lyskom-w3-region (start end)
(w3-region start end)
(add-text-properties start (min (point-max) end) '(end-closed nil)))
(defun lyskom-format-html (text) (defun lyskom-format-html (text)
(condition-case e (require 'w3) (error nil)) (condition-case e (require 'w3) (error nil))
(let ((tmpbuf (lyskom-get-buffer-create 'lyskom-html " lyskom-html" t))) (add-text-properties 0 (length text) '(special-insert lyskom-w3-region) text)
(unwind-protect (substring text 5))
(save-excursion
(set-buffer tmpbuf) ;;;(defun lyskom-format-html (text)
(insert (substring text 5)) ;;; (condition-case e (require 'w3) (error nil))
(insert " ") ; So we can adjust the extents ;;; (let ((tmpbuf (lyskom-get-buffer-create 'lyskom-html " lyskom-html" t)))
(w3-region (point-max) (point-min)) ;;; (unwind-protect
(let ((tmp nil)) ;;; (save-excursion
(map-extents ;;; (set-buffer tmpbuf)
(lambda (e x) ;;; (insert (substring text 5))
(if (zerop (- (extent-start-position e) ;;; (insert " ") ; So we can adjust the extents
(extent-end-position e))) ;;; (w3-region (point-max) (point-min))
(set-extent-endpoints e (extent-start-position e) ;;; (let ((tmp nil))
(1+ (extent-end-position e)))) ;;; (map-extents
(progn ;;; (lambda (e x)
(set-extent-property e 'duplicable t) ;;; (if (zerop (- (extent-start-position e)
(set-extent-property e 'replicable t)) ;;; (extent-end-position e)))
nil)) ;;; (set-extent-endpoints e (extent-start-position e)
(setq tmp (buffer-string)) ;;; (1+ (extent-end-position e))))
(add-text-properties 0 (length tmp) '(end-closed nil) tmp) ;;; (progn
tmp))))) ;;; (set-extent-property e 'duplicable t)
;;; (set-extent-property e 'replicable t))
;;; nil))
;;; (setq tmp (buffer-string))
;;; (add-text-properties 0 (length tmp) '(end-closed nil) tmp)
;;; tmp)))))
(defun lyskom-format-enriched (text) (defun lyskom-format-enriched (text)
......
...@@ -224,6 +224,7 @@ the current buffer, and its value is copied from the LysKOM buffer." ...@@ -224,6 +224,7 @@ the current buffer, and its value is copied from the LysKOM buffer."
(require 'cus-face) ; lww (require 'cus-face) ; lww
(apply (quote (, fn)) args))))) (apply (quote (, fn)) args)))))
(lyskom-widget-wrapper define-widget)
(lyskom-widget-wrapper widget-at) (lyskom-widget-wrapper widget-at)
(lyskom-widget-wrapper widget-value) (lyskom-widget-wrapper widget-value)
(lyskom-widget-wrapper widget-button-click) (lyskom-widget-wrapper widget-button-click)
......
...@@ -238,12 +238,33 @@ ...@@ -238,12 +238,33 @@
(lyskom-get-menu-category menu-category)) (lyskom-get-menu-category menu-category))
(setq lyskom-current-menu-category (list menu-category))) (setq lyskom-current-menu-category (list menu-category)))
;;;
;;; This function would have been completely unnecessary if Gnu Emacs
;;; didn't carry around an ancient version of popup-menu that is
;;; completely incompatible with XEmacs version of the same function.
;;; Sometimes I hate elisp.
;;;
(defun lyskom-do-popup-menu (menu event)
"Pop up a menu"
(lyskom-xemacs-or-gnu
(popup-menu menu event)
(let* ((result (nreverse (x-popup-menu (or event t)
(list menu)))))
(cond ((listp (car result))
(apply (car (car result))
(cdr (car result))))
((commandp (car result))
(call-interactively (car (nreverse result))))
((functionp (car result))
(funcall (car result)))
(t nil)))))
(defun lyskom-background-menu (pos event) (defun lyskom-background-menu (pos event)
"Pop up a menu with LysKOM commands and execute the selected command." "Pop up a menu with LysKOM commands and execute the selected command."
(let* ((menu lyskom-popup-menu) (let* ((menu lyskom-popup-menu)
(result (popup-menu menu event))))) (result (lyskom-do-popup-menu menu event)))))
......
...@@ -252,7 +252,12 @@ customize buffer but do not save them to the server." ...@@ -252,7 +252,12 @@ customize buffer but do not save them to the server."
(mapcar (mapcar
(function (function
(lambda (x) (lambda (x)
(princ (format "(setq %S %S)\n" (car x) (cdr x))))) (princ (format "(setq %S %s%S)\n"
(car x)
(cond ((symbolp (cdr x)) "'")
((listp (cdr x)) "'")
(t ""))
(cdr x)))))
var-list) var-list)
(princ ";;; ============================\n") (princ ";;; ============================\n")
(princ ";;; End of LysKOM Settings\n")) (princ ";;; End of LysKOM Settings\n"))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment