[Date Prev][Date Next][Thread Prev][][Date Index][Thread Index]

today's patch



西田です。

ちょこちょこと修正・単純化など。

* 簡易版 and-let* を作ってみた。(Scheme のマクロ)
* expand した url を text-property で保存するようにした。
* w3m-anchor, w3m-image という関数を作った。

-- Kei

--- w3m.el.~1.51.~	Sun Mar  4 19:32:15 2001
+++ w3m.el	Sun Mar  4 21:28:33 2001
@@ -404,6 +404,14 @@
   "Regexp used in parsing `<META content=\"...;charset=...\" HTTP-EQUIV=\"Content-Type\">
 for a charset indication")
 
+(put 'and-let* 'lisp-indent-function 1)
+(defmacro and-let* (varlist &rest body)
+  (if (null varlist)
+      (cons 'progn body)
+    (` (let ((, (car varlist)))
+	 (if (, (caar varlist))
+	     (and-let* (, (cdr varlist))
+	       (,@ body)))))))
 
 (defun w3m-message (&rest args)
   "Alternative function of `message' for w3m.el."
@@ -536,9 +544,9 @@
 	(delete-region start (match-end 0))
 	(cond (url
 	       (when (search-forward "</a>" nil t)
+		 (setq url (w3m-expand-url url w3m-current-url))
 		 (delete-region (setq end (match-beginning 0)) (match-end 0))
-		 (if (member (w3m-expand-url url w3m-current-url)
-			     w3m-arrived-anchor-list)
+		 (if (member url w3m-arrived-anchor-list)
 		     (put-text-property start end 'face 'w3m-arrived-anchor-face)
 		   (put-text-property start end 'face 'w3m-anchor-face))
 		 (put-text-property start end 'w3m-href-anchor url)
@@ -558,7 +566,8 @@
 	(delete-region start (match-end 0))
 	(when (search-forward "</img_alt>" nil t)
 	  (delete-region (setq end (match-beginning 0)) (match-end 0))
+	  (setq src (w3m-expand-url src w3m-current-url))
 	  (put-text-property start end 'face 'w3m-image-face)
 	  (put-text-property start end 'w3m-image src)
 	  (put-text-property start end 'mouse-face 'highlight))))
@@ -1218,122 +1228,123 @@
 
 (defun w3m-expand-url (url base)
   "Convert URL to absolute, and canonicalize it."
-  (if (not base) (setq base ""))
-  (if (string-match "^[^:]+://[^/]*$" base)
-      (setq base (concat base "/")))
-  (cond
-   ;; URL is relative on BASE.
-   ((string-match "^#" url)
-    (concat base url))
-   ;; URL has absolute spec.
-   ((string-match "^[^:]+:" url)
-    url)
-   ((string-match "^/" url)
-    (if (string-match "^\\([^:]+://[^/]*\\)/" base)
-	(concat (match-string 1 base) url)
-      url))
-   (t
-    (let ((server "") path)
+  (save-match-data
+    (if (not base) (setq base ""))
+    (if (string-match "^[^:]+://[^/]*$" base)
+	(setq base (concat base "/")))
+    (cond
+     ;; URL is relative on BASE.
+     ((string-match "^#" url)
+      (concat base url))
+     ;; URL has absolute spec.
+     ((string-match "^[^:]+:" url)
+      url)
+     ((string-match "^/" url)
       (if (string-match "^\\([^:]+://[^/]*\\)/" base)
-	  (setq server (match-string 1 base)
-		base (substring base (match-end 1))))
-      (setq path (expand-file-name url (file-name-directory base)))
-      ;; remove drive (for Win32 platform)
-      (if (string-match "^.:" path)
-	  (setq path (substring path (match-end 0))))
-      (concat server path)))))
+	  (concat (match-string 1 base) url)
+	url))
+     (t
+      (let ((server "") path)
+	(if (string-match "^\\([^:]+://[^/]*\\)/" base)
+	    (setq server (match-string 1 base)
+		  base (substring base (match-end 1))))
+	(setq path (expand-file-name url (file-name-directory base)))
+	;; remove drive (for Win32 platform)
+	(if (string-match "^.:" path)
+	    (setq path (substring path (match-end 0))))
+	(concat server path))))))
+
+(defun w3m-anchor (&optional point)
+  (get-text-property (or point (point)) 'w3m-href-anchor))
 
+(defun w3m-image (&optional point)
+  (get-text-property (or point (point)) 'w3m-image))
 
 (defun w3m-view-this-url (&optional arg)
   "*View the URL of the link under point."
   (interactive "P")
-  (let ((url (get-text-property (point) 'w3m-href-anchor)))
-    (if url (w3m-goto-url (w3m-expand-url url w3m-current-url) arg))))
+  (and-let* ((url (w3m-anchor)))
+    (w3m-goto-url url arg)))
 
 (defun w3m-mouse-view-this-url (event)
   (interactive "e")
   (mouse-set-point event)
-  (let ((url (get-text-property (point) 'w3m-href-anchor))
-	(img (get-text-property (point) 'w3m-image)))
+  (let ((url (w3m-anchor)) (img (w3m-image)))
     (cond
      (url (w3m-view-this-url))
      (img (w3m-view-image))
      (t (message "No URL at point.")))))
 
-(defun w3m-external-view (content-type url)
-  (let ((method (nth 2 (assoc content-type w3m-content-type-alist))))
-    (if method
-	(cond
-	 ((not method)
-	  (message "No external viewer is defined."))
-	 ((functionp method)
-	  (funcall method url))
-	 ((consp method)
-	  (let ((command (car method))
-		(arguments (cdr method))
-		(file (make-temp-name
-		       (expand-file-name "w3mel" w3m-profile-directory)))
-		(proc))
-	    (unwind-protect
-		(with-current-buffer
-		    (generate-new-buffer " *w3m-external-view*")
-		  (if (memq 'file arguments) (w3m-download url file))
-		  (setq proc
-			(apply 'start-process
-			       "w3m-external-view"
-			       (current-buffer)
-			       command
-			       (mapcar (function eval) arguments)))
-		  (setq w3m-process-temp-file file)
-		  (set-process-sentinel
-		   proc
-		   (lambda (proc event)
-		     (and (string-match "^\\(finished\\|exited\\)" event)
-			  (buffer-name (process-buffer proc))
-			  (save-excursion
-			    (set-buffer (process-buffer proc))
-			    (if (file-exists-p w3m-process-temp-file)
-				(delete-file w3m-process-temp-file)))
-			  (kill-buffer (process-buffer proc))))))
-	      (if (file-exists-p file)
-		  (unless (and (processp proc)
-			       (memq (process-status proc) '(run stop)))
-		    (delete-file file)))))))
-      (error "Unknown content type: %s" content-type))))
+(defun w3m-external-view (url)
+  (let ((method (nth 2 (assoc (w3m-content-type url) w3m-content-type-alist))))
+    (cond
+     ((not method)
+      (error "Unknown content type: %s" content-type))
+     ((functionp method)
+      (funcall method url))
+     ((consp method)
+      (let ((command (car method))
+	    (arguments (cdr method))
+	    (file (make-temp-name
+		   (expand-file-name "w3mel" w3m-profile-directory)))
+	    (proc))
+	(unwind-protect
+	    (with-current-buffer
+		(generate-new-buffer " *w3m-external-view*")
+	      (if (memq 'file arguments) (w3m-download url file))
+	      (setq proc
+		    (apply 'start-process
+			   "w3m-external-view"
+			   (current-buffer)
+			   command
+			   (mapcar (function eval) arguments)))
+	      (setq w3m-process-temp-file file)
+	      (set-process-sentinel
+	       proc
+	       (lambda (proc event)
+		 (and (string-match "^\\(finished\\|exited\\)" event)
+		      (buffer-name (process-buffer proc))
+		      (save-excursion
+			(set-buffer (process-buffer proc))
+			(if (file-exists-p w3m-process-temp-file)
+			    (delete-file w3m-process-temp-file)))
+		      (kill-buffer (process-buffer proc))))))
+	  (if (file-exists-p file)
+	      (unless (and (processp proc)
+			   (memq (process-status proc) '(run stop)))
+		(delete-file file)))))))))
 
 (defun w3m-view-image ()
   "*View the image under point."
   (interactive)
-  (let ((file (get-text-property (point) 'w3m-image)))
-    (if file
-	(let ((url (w3m-expand-url file w3m-current-url)))
-	  (w3m-external-view (w3m-content-type url) url))
+  (let ((url (w3m-image)))
+    (if url
+	(w3m-external-view url)
       (message "No file at point."))))
 
 (defun w3m-save-image ()
   "*Save the image under point to a file."
   (interactive)
-  (let ((file (get-text-property (point) 'w3m-image)))
-    (if file
-	(w3m-download (w3m-expand-url file w3m-current-url))
+  (let ((url (w3m-image)))
+    (if url
+	(w3m-download url)
       (message "No file at point."))))
 
 (defun w3m-view-current-url-with-external-browser ()
   "*View this URL."
   (interactive)
-  (let ((url (get-text-property (point) 'w3m-href-anchor)))
-    (if url
-	(setq url (w3m-expand-url url w3m-current-url))
-      (if (y-or-n-p (format "Browse <%s> ? " w3m-current-url))
-	  (setq url w3m-current-url)))
+  (let ((url (w3m-anchor)))
+    (or url
+	(y-or-n-p (format "Browse <%s> ? " w3m-current-url))
+	(setq url w3m-current-url))
     (when url
       (message "Browse <%s>" url)
-      (w3m-external-view (w3m-content-type url) url))))
+      (w3m-external-view url))))
 
 (defun w3m-download-this-url ()
   "*Download the URL of the link under point to a file."
   (interactive)
-  (let ((url (get-text-property (point) 'w3m-href-anchor)))
+  (let ((url (w3m-anchor)))
     (if url
 	(progn
 	  (w3m-download url)
@@ -1349,25 +1360,22 @@
 (defun w3m-print-this-url ()
   "*Print the URL of the link under point."
   (interactive)
-  (let ((url (get-text-property (point) 'w3m-href-anchor)))
-    (message "%s" (if url
-		      (w3m-expand-url url w3m-current-url)
-		    "Not found"))))
+  (let ((url (w3m-anchor)))
+    (message "%s" (or url "Not found"))))
 
 (defun w3m-save-this-url ()
   (interactive)
-  (let ((url (get-text-property (point) 'w3m-href-anchor)))
-    (if url
-	(kill-new (w3m-expand-url url w3m-current-url)))))
+  (and-let* ((url (w3m-anchor)))
+    (kill-new url)))
 
 (defun w3m-goto-next-anchor ()
   ;; move to the end of the current anchor
-  (when (get-text-property (point) 'w3m-href-anchor)
+  (when (w3m-anchor)
     (goto-char (next-single-property-change (point) 'w3m-href-anchor)))
   ;; find the next anchor
-  (if (get-text-property (point) 'w3m-href-anchor) t
-    (let ((pos (next-single-property-change (point) 'w3m-href-anchor)))
-      (if pos (progn (goto-char pos) t) nil))))
+  (or (w3m-anchor)
+      (let ((pos (next-single-property-change (point) 'w3m-href-anchor)))
+	(if pos (progn (goto-char pos) t) nil))))
 
 (defun w3m-next-anchor (&optional arg)
   "*Move cursor to the next anchor."
@@ -1385,13 +1393,13 @@
 
 (defun w3m-goto-previous-anchor ()
   ;; move to the beginning of the current anchor
-  (when (get-text-property (point) 'w3m-href-anchor)
+  (when (w3m-anchor)
     (goto-char (previous-single-property-change (1+ (point))
 						'w3m-href-anchor)))
   ;; find the previous anchor
   (let ((pos (previous-single-property-change (point) 'w3m-href-anchor)))
     (if pos (goto-char
-	     (if (get-text-property pos 'w3m-href-anchor) pos
+	     (if (w3m-anchor pos) pos
 	       (previous-single-property-change pos 'w3m-href-anchor))))))
 
 (defun w3m-previous-anchor (&optional arg)
@@ -1805,14 +1813,15 @@
 (defun w3m-bookmark-add-this-url ()
   "Add link under cursor to bookmark."
   (interactive)
-  (if (null (get-text-property (point) 'w3m-href-anchor))
+  (if (not (w3m-anchor))
       (message "No anchor.")		; nothing to do
-    (w3m-bookmark-add
-     (get-text-property (point) 'w3m-href-anchor) ; url
-     (buffer-substring-no-properties	; title
-      (previous-single-property-change (1+ (point)) 'w3m-href-anchor)
-      (next-single-property-change (point) 'w3m-href-anchor)))
+    (let ((url (w3m-anchor))
+	  (title (buffer-substring-no-properties
+		  (previous-single-property-change (1+ (point))
+						   'w3m-href-anchor)
+		  (next-single-property-change (point) 'w3m-href-anchor))))
+      (w3m-bookmark-add url title))
     (message "Added.")))