Synkade strängar, bugfixar

src/ChangeLog

+Wed Jul  2 15:35:16 1997  David Byers  <davby@ida.liu.se>
+
+	* swedish-strings.el,english-strings.el: Synkade alla strngar.
+
+	* vars.el.in (lyskom-commands): Lade till kom-change-language. 
+	Varfr har vi egentligen den hr variabeln?
+
+	* startup.el (kom-start-anew): Stt sprk enligt 
+	kom-default-language i slutet av inloggningen.
+
+	* services.el (lyskom-blocking-do-multiple-1): Flyttade frn 
+	macros.el.
+	(lyskom-blocking-do-multiple): Dito.
+	(lyskom-multiple-blocking-return): Dito.
+
+	* vars.el.in (kom-default-language): Ny variabel.
+
+	* option-edit.el: Lade till kom-default-language
+
+	* commands2.el (kom-change-language): Ny funktion
+
+	* services.el (blocking-do): terstllde.
+	(lyskom-wait-queue): terstllde.
+
+	* macros.el (lyskom-blocking-do-multiple): terstllde.
+
+	* filter.el (lyskom-filter-text-p): terstllde.
+
+	* utilities.el: terstllde.
+
+	* lyskom-rest.el (lyskom-filter): terstllde.
+
 Wed Jul  2 13:07:38 1997  Peter Liljenberg  <petli@lysator.liu.se>
 
 	* lyskom-rest.el (lyskom-filter): Tog bort
@@ -10,11 +42,41 @@ Wed Jul  2 13:07:38 1997  Peter Liljenberg  <petli@lysator.liu.se>
 	macros.el (lyskom-blocking-do-multiple),
 	services.el (blocking-do): Fixade accept-process-output.
 
+Wed Jul  2 10:44:38 1997  David Byers  <davby@ida.liu.se>
+
+	* vars.el.in (lyskom-send-text-transform-function): Ny variabel.
+
+	* defvar.el (def-kom-var): Gr variabler i common-arean 
+	lokala ocks.
+
+	* edit-text.el (lyskom-send-transform-text): Hantera att det 
+	blir fel nr man frsker skicka in.
+
+	* lyskom-rest.el (lyskom-format-special): Bytt namn frn 
+	lyskom-format-experimental. Flyttad till vars.el.in
+	(lyskom-format-html): Ny funktion.
+	(lyskom-format-enriched): Ny funktion.
+	(lyskom-format-text-body): Anvnd dem.
+
 Tue Jul  1 18:26:42 1997  Peter Liljenberg  <petli@lysator.liu.se>
 
 	* check-strings.el: Helt omskriven fr att klara det nya
 	strngsystemet. 
 
+Mon Jun 30 14:01:31 1997  David Byers  <davby@ida.liu.se>
+
+	* review.el (kom-review-noconversion): Ignorera dynamiskt 
+	bunden variabel. 
+
+	* commands2.el (kom-membership): Tog bort ondig variabel.
+	(kom-set-unread): Ignorera tempvariabel
+
+	* utilities.el (lyskom-modify-face): Tog bort ondig variabel.
+
+	* compatibility.el (map-keymap): Tog bort ondig variabel.
+
+	* option-edit.el (lyskom-widget-click): Nu funktion.
+
 Sun Jun 29 12:41:14 1997  David Byers  <davby@ida.liu.se>
 
 	* swedish-strings.el (lyskom-custom-strings): Lade till Lynx.

src/Makefile

@@ -106,8 +106,8 @@ lyskom.elc: lyskom.el
 	$(EMACS-BATCH) -l ./lpath.el -f batch-byte-compile lyskom.el
 
 .PHONY: check
-check: 
-	$(EMACS-BATCH) -l check-strings.el -f run
+check: lyskom.el
+	$(EMACS-BATCH) -l ./lyskom.el  -l ./check-strings.el -f lyskom-check-strings
 
 # Do "make verbose" to see where things go wrong
 .PHONY: verbose

src/command.el

@@ -86,7 +86,7 @@
 
 (defsubst lyskom-command-name (command)
   "Get the command name for the command COMMAND"
-  (condition-case arg
+  (condition-case nil
       (lyskom-get-string command 'lyskom-command)
     (error nil)))
 

src/commands1.el

@@ -1506,20 +1506,22 @@ If MARK-NO == 0, review all marked texts."
 						 (time->sec  time))))
 		       (error nil))))))
             lyskom-times)
-    (let ((tmp (lyskom-nameday time)))
-      (when tmp
-        (lyskom-insert "\n")
-        (lyskom-insert tmp))))
+;;; +++ FIXME specialhack för svenska. Borde det generaliseras?
+    (when (eq lyskom-language 'sv)
+      (let ((tmp (lyskom-nameday time)))
+        (when tmp
+          (lyskom-insert "\n")
+          (lyskom-insert tmp)))))
   (lyskom-insert "\n"))
 
 
-(def-kom-command kom-display-calendar ()
-  "Nothing yet"
-  (interactive)
-  (let* ((time (blocking-do 'get-time))
-         (nameday (lyskom-nameday time))
-         (special (lyskom-special-date time)))
-    ))
+;(def-kom-command kom-display-calendar ()
+;  "Nothing yet"
+;  (interactive)
+;  (let* ((time (blocking-do 'get-time))
+;         (nameday (lyskom-nameday time))
+;         (special (lyskom-special-date time)))
+;    ))
     
 (defvar lyskom-nameday-alist
   '((1 . ((1 . ())

src/commands2.el

@@ -46,8 +46,7 @@
 (def-kom-command kom-membership ()
   "Show memberships last visited, priority, unread and name."
   (interactive)
-  (let ((buf (current-buffer))
-	(buffer (lyskom-get-buffer-create 'list-membership
+  (let ((buffer (lyskom-get-buffer-create 'list-membership
                                           (concat (buffer-name 
                                                    (current-buffer))
                                                   "-membership")
@@ -629,6 +628,7 @@ send. If DONTSHOW is non-nil, don't display the sent message."
 					lyskom-pers-no
 					conf-no))
 	       )
+          (ignore result)
 	  (lyskom-replace-membership membership lyskom-membership)
 	  (if (= conf-no lyskom-current-conf)
 	      (set-read-list-empty lyskom-reading-list))
@@ -1650,3 +1650,20 @@ membership info."
 				       lyskom-errno))))))
 
 
+;;; ============================================================
+;;; ndra sprk
+;;;
+
+(def-kom-command kom-change-language ()
+  "Change the current language in LysKOM"
+  (interactive)
+  (let* ((completion-ignore-case t)
+         (table (mapcar (function (lambda (x) (cons (elt x 1) (elt x 0))))
+                        lyskom-languages))
+         (language (completing-read
+                   (lyskom-get-string 'which-language)
+                   table
+                   nil
+                   t)))
+    (when (lyskom-string-assoc language table)
+      (lyskom-set-language (cdr (lyskom-string-assoc language table))))))

src/compatibility.el

@@ -153,8 +153,7 @@ of the lyskom-provide-* functions instead."
 ;;;
 
 (lyskom-provide-function map-keymap (fn keymap &optional sort-first)
-  (let ((lis nil)
-        (r 0))
+  (let ((r 0))
     (cond ((vectorp keymap)
            (while (< r (length keymap))
              (if (aref keymap r)

src/completing-read.el

@@ -512,20 +512,20 @@ function work as a name-to-conf-stat translator."
                 (null x-list)))))
 
 
-(defun lyskom-complete-show-data-list (state data)
-  (save-excursion
-    (pop-to-buffer (get-buffer-create "*kom*-complete"))
-    (erase-buffer)
-    (while data
-      (insert
-       (format "%s\n" (substring (aref (car data) 2)
-                                 (aref (car data) 0)
-                                 (aref (car data) 1))))
-      (setq data (cdr data)))
-    (insert (format "%S %S: %S" (symbol-value current-state)
-                    (elt state 0)
-                    (elt state 1)))
-    (sit-for 1)))
+;(defun lyskom-complete-show-data-list (state data)
+;  (save-excursion
+;    (pop-to-buffer (get-buffer-create "*kom*-complete"))
+;    (erase-buffer)
+;    (while data
+;      (insert
+;       (format "%s\n" (substring (aref (car data) 2)
+;                                 (aref (car data) 0)
+;                                 (aref (car data) 1))))
+;      (setq data (cdr data)))
+;    (insert (format "%S %S: %S" (symbol-value current-state)
+;                    (elt state 0)
+;                    (elt state 1)))
+;    (sit-for 1)))
       
 
 (defun lyskom-complete-string (string-list)
@@ -771,8 +771,7 @@ the LysKOM rules of string matching."
    (lyskom-complete-string-close-parens-2 el depth)))
 
 (defun lyskom-complete-string-close-parens-2 (el depth)
-  (let ((tmp nil)
-        (string (aref el 2))
+  (let ((string (aref el 2))
         (pos (aref el 0)))
     (while (> depth 0)
       (cond ((>= pos (length string)) 

src/cus-face.el

@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.61
+;; Version: 1.9941
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -15,29 +15,53 @@
 
 (require 'custom)
 
-(eval-and-compile (require 'cl))
+(eval-when-compile (require 'cl))
 
 ;;; Compatibility.
 
+(if (string-match "XEmacs" emacs-version)
+    (defun custom-face-background (face &optional frame)
+      ;; Specifiers suck!
+      "Return the background color name of face FACE, or nil if unspecified."
+      (color-instance-name (specifier-instance (face-background face) frame)))
+  (defalias 'custom-face-background 'face-background))
+
+(if (string-match "XEmacs" emacs-version)
+    (defun custom-face-foreground (face &optional frame)
+      ;; Specifiers suck!
+      "Return the background color name of face FACE, or nil if unspecified."
+      (color-instance-name (specifier-instance (face-foreground face) frame)))
+  (defalias 'custom-face-foreground 'face-foreground))
+
+(defalias 'custom-face-font-name (if (string-match "XEmacs" emacs-version)
+				     'face-font-name
+				   'face-font))
+
 (eval-and-compile
-  (unless (fboundp 'frame-property)
-    ;; XEmacs function missing in Emacs 19.34.
-    (defun frame-property (frame property &optional default)
-      "Return FRAME's value for property PROPERTY."
-      (or (cdr (assq property (frame-parameters frame)))
-	  default)))
+  (cond ((fboundp 'frame-property)
+	 ;; XEmacs.
+	 (defalias 'custom-frame-parameter 'frame-property))
+	((fboundp 'frame-parameter)
+	 ;; Emacs 19.35.
+	 (defalias 'custom-frame-parameter 'frame-parameter))
+	(t
+	 ;; Old emacsen.
+	 (defun custom-frame-parameter (frame property &optional default)
+	   "Return FRAME's value for property PROPERTY."
+	   (or (cdr (assq property (frame-parameters frame)))
+	       default))))
 
   (unless (fboundp 'face-doc-string)
     ;; XEmacs function missing in Emacs.
     (defun face-doc-string (face)
       "Get the documentation string for FACE."
-      (get face 'face-doc-string)))
+      (get face 'face-documentation)))
 
   (unless (fboundp 'set-face-doc-string)
     ;; XEmacs function missing in Emacs.
     (defun set-face-doc-string (face string)
       "Set the documentation string for FACE to STRING."
-      (put face 'face-doc-string string))))
+      (put face 'face-documentation string))))
 
 (unless (fboundp 'x-color-values)
   ;; Emacs function missing in XEmacs 19.14.
@@ -111,33 +135,33 @@ Does nothing when the variable initialize-face-resources is nil."
        ;; Too hard to do right on XEmacs.
        (defalias 'initialize-face-resources 'ignore)))
 
-(if (string-match "XEmacs" emacs-version)
-    ;; Xemacs.
-    (defun custom-invert-face (face &optional frame)
-      "Swap the foreground and background colors of face FACE.
-If the colors are not specified in the face, use the default colors."
-      (interactive (list (read-face-name "Reverse face: ")))
-      (let ((fg (color-name (face-foreground face frame) frame))
-	    (bg (color-name (face-background face frame) frame)))
-	(set-face-foreground face bg frame)
-	(set-face-background face fg frame)))
-  ;; Emacs.
-  (defun custom-invert-face (face &optional frame)
-    "Swap the foreground and background colors of face FACE.
-If the colors are not specified in the face, use the default colors."
-    (interactive (list (read-face-name "Reverse face: ")))
-    (let ((fg (or (face-foreground face frame)
-		  (face-foreground 'default frame)
-		  (frame-property (or frame (selected-frame))
-				  'foreground-color)
-		  "black"))
-	  (bg (or (face-background face frame)
-		  (face-background 'default frame)
-		  (frame-property (or frame (selected-frame))
-				  'background-color)
-		  "white")))
-      (set-face-foreground face bg frame)
-      (set-face-background face fg frame))))
+;;(if (string-match "XEmacs" emacs-version)
+;;    ;; Xemacs.
+;;    (defun custom-invert-face (face &optional frame)
+;;      "Swap the foreground and background colors of face FACE.
+;;If the colors are not specified in the face, use the default colors."
+;;      (interactive (list (read-face-name "Reverse face: ")))
+;;      (let ((fg (color-name (face-foreground face frame) frame))
+;;	    (bg (color-name (face-background face frame) frame)))
+;;	(set-face-foreground face bg frame)
+;;	(set-face-background face fg frame)))
+;;  ;; Emacs.
+;;  (defun custom-invert-face (face &optional frame)
+;;    "Swap the foreground and background colors of face FACE.
+;;If the colors are not specified in the face, use the default colors."
+;;    (interactive (list (read-face-name "Reverse face: ")))
+;;    (let ((fg (or (face-foreground face frame)
+;;		  (face-foreground 'default frame)
+;;		  (custom-frame-parameter (or frame (selected-frame))
+;;				  'foreground-color)
+;;		  "black"))
+;;	  (bg (or (face-background face frame)
+;;		  (face-background 'default frame)
+;;		  (custom-frame-parameter (or frame (selected-frame))
+;;				  'background-color)
+;;		  "white")))
+;;      (set-face-foreground face bg frame)
+;;      (set-face-background face fg frame))))
 
 (defcustom custom-background-mode nil
   "The brightness of the background.
@@ -145,9 +169,9 @@ Set this to the symbol dark if your background color is dark, light if
 your background is light, or nil (default) if you want Emacs to
 examine the brightness for you."
   :group 'customize
-  :type '(choice (choice-item dark) 
-		 (choice-item light)
-		 (choice-item :tag "default" nil)))
+  :type '(choice (const dark) 
+		 (const light)
+		 (const :tag "default" nil)))
 
 (defun custom-background-mode (frame)
   "Kludge to detect background mode for FRAME."
@@ -159,12 +183,11 @@ examine the brightness for you."
 	 (mode (cond (bg-resource
 		      (intern (downcase bg-resource)))
 		     ((and (setq color (condition-case ()
-					   (or (frame-property
+					   (or (custom-frame-parameter
 						frame
 						'background-color)
-					       (color-instance-name
-						(specifier-instance
-						 (face-background 'default))))
+					       (custom-face-background
+						'default))
 					 (error nil)))
 			   (or (string-match "XEmacs" emacs-version)
 			       window-system)
@@ -184,16 +207,16 @@ examine the brightness for you."
 	(list 'type (device-type (frame-device frame))
 	      'class (device-class (frame-device frame))
 	      'background (or custom-background-mode
-			      (frame-property frame
+			      (custom-frame-parameter frame
 					      'background-mode)
 			      (custom-background-mode frame))))
     ;; Emacs.
     (defun custom-extract-frame-properties (frame)
       "Return a plist with the frame properties of FRAME used by custom."
       (list 'type window-system
-	    'class (frame-property frame 'display-type)
+	    'class (custom-frame-parameter frame 'display-type)
 	    'background (or custom-background-mode
-			    (frame-property frame 'background-mode)
+			    (custom-frame-parameter frame 'background-mode)
 			    (custom-background-mode frame))))))  
 
 ;;; Declaring a face.
@@ -201,11 +224,13 @@ examine the brightness for you."
 ;;;###autoload
 (defun custom-declare-face (face spec doc &rest args)
   "Like `defface', but FACE is evaluated as a normal argument."
-  (when (fboundp 'load-gc)
+  (when (or (fboundp 'load-gc)		;XEmacs.
+	    ;; Emacs.
+	    (and (boundp purify-flag) purify-flag))
     ;; This should be allowed, somehow.
     (error "Attempt to declare a face during dump"))
-  (unless (get face 'factory-face)
-    (put face 'factory-face spec)
+  (unless (get face 'face-defface-spec)
+    (put face 'face-defface-spec spec)
     (when (fboundp 'facep)
       (unless (custom-facep face)
 	;; If the user has already created the face, respect that.
@@ -230,45 +255,53 @@ examine the brightness for you."
 ;;; Font Attributes.
 
 (defconst custom-face-attributes
-  '((:bold (toggle :format "Bold: %[%v%]\n"
-		   :help-echo "Control whether a bold font should be used.")
-	   custom-set-face-bold)
-    (:italic (toggle :format "Italic: %[%v%]\n"
-		     :help-echo "\
+  '((:bold (boolean :tag "Bold"
+		    :help-echo "Control whether a bold font should be used.")
+	   custom-set-face-bold 
+	   custom-face-bold)
+    (:italic (boolean :tag "Italic"
+		      :help-echo "\
 Control whether an italic font should be used.")
-	     custom-set-face-italic)
-    (:underline (toggle :format "Underline: %[%v%]\n"
-			:help-echo "\
+	     custom-set-face-italic
+	     custom-face-italic)
+    (:underline (boolean :tag "Underline"
+			 :help-echo "\
 Control whether the text should be underlined.")
-		set-face-underline-p)
+		set-face-underline-p
+		face-underline-p)
     (:foreground (color :tag "Foreground"
 			:value "black"
 			:help-echo "Set foreground color.")
-		 set-face-foreground)
+		 set-face-foreground
+		 custom-face-foreground)
     (:background (color :tag "Background"
 			:value "white"
 			:help-echo "Set background color.")
-		 set-face-background)
-    (:invert (const :format "Invert Face\n" 
-		    :sibling-args (:help-echo "\
-Reverse the foreground and background color.
-If you haven't specified them for the face, the default colors will be used.")
-		    t)
-	     (lambda (face value &optional frame)
-	       ;; We don't use VALUE.
-	       (custom-invert-face face frame)))
+		 set-face-background
+		 custom-face-background)
+    ;;    (:invert (const :format "Invert Face\n" 
+    ;;		    :sibling-args (:help-echo "
+    ;;Reverse the foreground and background color.
+    ;;If you haven't specified them for the face, the default colors will be used.")
+    ;;		    t)
+    ;;	     (lambda (face value &optional frame)
+    ;;	       ;; We don't use VALUE.
+    ;;	       (custom-invert-face face frame)))
     (:stipple (editable-field :format "Stipple: %v"
 			      :help-echo "Name of background bitmap file.")
-	      set-face-stipple))
+	      set-face-stipple custom-face-stipple))
   "Alist of face attributes. 
 
-The elements are of the form (KEY TYPE SET) where KEY is a symbol
+The elements are of the form (KEY TYPE SET GET) where KEY is a symbol
 identifying the attribute, TYPE is a widget type for editing the
-attibute, SET is a function for setting the attribute value.
+attibute, SET is a function for setting the attribute value, and GET is a function for getiing the attribute value. 
 
 The SET function should take three arguments, the face to modify, the
 value of the attribute, and optionally the frame where the face should
-be changed.")
+be changed.
+
+The GET function should take two arguments, the face to examine, and
+optonally the frame where the face should be examined.")
 
 (defun custom-face-attributes-set (face frame &rest atts)
   "For FACE on FRAME set the attributes [KEYWORD VALUE]....
@@ -284,52 +317,124 @@ If FRAME is nil, set the default face."
 	  (funcall fun face value frame)
 	(error nil)))))
 
+(defun custom-face-attributes-get (face frame)
+  "For FACE on FRAME get the attributes [KEYWORD VALUE]....
+Each keyword should be listed in `custom-face-attributes'.
+
+If FRAME is nil, use the default face."
+  (condition-case nil
+      ;; Attempt to get `font.el' from w3.
+      (require 'font)
+    (error nil))
+  (let ((atts custom-face-attributes)
+	att result get)
+    (while atts
+      (setq att (car atts)
+	    atts (cdr atts)
+	    get (nth 3 att))
+      (condition-case nil
+	  ;; This may fail if w3 doesn't exists.
+	  (when get 
+	    (let ((answer (funcall get face frame)))
+	      (unless (equal answer (funcall get 'default frame))
+		(when (widget-apply (nth 1 att) :match answer)
+		  (setq result (cons (nth 0 att) (cons answer result)))))))
+	(error nil)))
+    result))
+
 (defun custom-set-face-bold (face value &optional frame)
   "Set the bold property of FACE to VALUE."
   (if value
       (make-face-bold face frame)
     (make-face-unbold face frame)))
 
+(defun custom-face-bold (face &rest args)
+  "Return non-nil if the font of FACE is bold."
+  (let* ((font (apply 'custom-face-font-name face args))
+	 (fontobj (font-create-object font)))
+    (font-bold-p fontobj)))
+
 (defun custom-set-face-italic (face value &optional frame)
   "Set the italic property of FACE to VALUE."
   (if value
       (make-face-italic face frame)
     (make-face-unitalic face frame)))
 
+(defun custom-face-italic (face &rest args)
+  "Return non-nil if the font of FACE is italic."
+  (let* ((font (apply 'custom-face-font-name face args))
+	 (fontobj (font-create-object font)))
+    (font-italic-p fontobj)))
+
+(defun custom-face-stipple (face &rest args)
+  "Return the name of the stipple file used for FACE."
+  (if (string-match "XEmacs" emacs-version)
+      (let ((image  (apply 'specifier-instance 
+			   (face-background-pixmap face) args)))
+	(when image 
+	  (image-instance-file-name image)))
+    (apply 'face-stipple face args)))
+
 (when (string-match "XEmacs" emacs-version)
   ;; Support for special XEmacs font attributes.
   (autoload 'font-create-object "font" nil)
 
-  (unless (fboundp 'face-font-name)
-    (defun face-font-name (face &rest args)
-      (apply 'face-font face args)))
-
   (defun custom-set-face-font-size (face size &rest args)
     "Set the font of FACE to SIZE"
-    (let* ((font (apply 'face-font-name face args))
+    (let* ((font (apply 'custom-face-font-name face args))
 	   (fontobj (font-create-object font)))
       (set-font-size fontobj size)
-      (apply 'set-face-font face fontobj args)))
+      (apply 'font-set-face-font face fontobj args)))
+
+  (defun custom-face-font-size (face &rest args)
+    "Return the size of the font of FACE as a string."
+    (let* ((font (apply 'custom-face-font-name face args))
+	   (fontobj (font-create-object font)))
+      (format "%s" (font-size fontobj))))
 
   (defun custom-set-face-font-family (face family &rest args)
-    "Set the font of FACE to FAMILY"
-    (let* ((font (apply 'face-font-name face args))
+    "Set the font of FACE to FAMILY."
+    (let* ((font (apply 'custom-face-font-name face args))
 	   (fontobj (font-create-object font)))
       (set-font-family fontobj family)
-      (apply 'set-face-font face fontobj args)))
+      (apply 'font-set-face-font face fontobj args)))
+
+  (defun custom-face-font-family (face &rest args)
+    "Return the name of the font family of FACE."
+    (let* ((font (apply 'custom-face-font-name face args))
+	   (fontobj (font-create-object font)))
+      (font-family fontobj)))
 
-  (nconc custom-face-attributes
-	 '((:family (editable-field :format "Font Family: %v"
-				    :help-echo "\
+  (setq custom-face-attributes
+	(append '((:family (editable-field :format "Font Family: %v"
+					  :help-echo "\
 Name of font family to use (e.g. times).") 
-		    custom-set-face-font-family)
-	   (:size (editable-field :format "Size: %v"
-				  :help-echo "\
+			  custom-set-face-font-family
+			  custom-face-font-family)
+		  (:size (editable-field :format "Size: %v"
+					 :help-echo "\
 Text size (e.g. 9pt or 2mm).")
-		  custom-set-face-font-size))))
+			 custom-set-face-font-size
+			 custom-face-font-size)
+		  (:strikethru (toggle :format "%[Strikethru%]: %v\n"
+				      :help-echo "\
+Control whether the text should be strikethru.")
+			       set-face-strikethru-p
+			       face-strikethru-p))
+		custom-face-attributes)))