Changeset 16352


Ignore:
Timestamp:
Jan 31, 2015, 9:32:59 PM (5 years ago)
Author:
svspire
Message:

New functions #'http-url, #'pathname-to-file-url, and
#'open-cocoa-window-with-url that can now be used on their own.
Refactor #'lookup-hyperspec-symbol to use them.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-doc.lisp

    r15988 r16352  
    133133                  (setf (gethash sym hash) url)))))))))
    134134
     135(defun http-url (url)
     136  "Returns an ns-url object given a string representing an http URL."
     137  (with-cfstring (s url)
     138    (#/absoluteURL
     139     (make-instance 'ns:ns-url
     140       :with-string s))))
     141
     142(defun pathname-to-file-url (pathname)
     143  "Returns an ns-url object given a string representing a file URL."
     144  (with-cfstring (s (native-translated-namestring pathname))
     145    (with-autorelease-pool
     146        (#/retain
     147         (#/fileURLWithPath: ns:ns-url s)))))
     148
     149(defun open-cocoa-window-with-url (url &optional (default-title "") (erf nil))
     150  (rlet ((pdocattrs :id +null-ptr+)
     151         (perror :id  +null-ptr+))
     152    (let* ((data (make-instance 'ns:ns-data
     153                   :with-contents-of-url url
     154                   :options 0
     155                   :error perror)))
     156      (if (not (%null-ptr-p (pref perror :id)))
     157          (when (functionp erf)
     158            (funcall erf (pref perror :id)))
     159          (let* ((string (make-instance 'ns:ns-attributed-string
     160                           :with-html data
     161                           :base-url url
     162                           :document-attributes pdocattrs))
     163                 (docattrs (pref pdocattrs :id))
     164                 (title #+cocotron +null-ptr+
     165                        #-cocotron
     166                        (if (%null-ptr-p docattrs)
     167                            +null-ptr+
     168                            (#/objectForKey: docattrs #&NSTitleDocumentAttribute))))
     169            (with-cfstring (nsdefault-title default-title)
     170              (if (%null-ptr-p title)
     171                  (setq title nsdefault-title))
     172              (#/newDisplayDocumentWithTitle:content:
     173               (#/sharedDocumentController ns:ns-document-controller)
     174               title
     175               string)))))))
     176
    135177(defun lookup-hyperspec-symbol (symbol doc)
    136178  (let* ((relative-url (gethash symbol (hyperspec-map-hash doc))))
     
    142184       
    143185        (if *lookup-hyperspec-in-browser*
    144           (ccl::%open-url-in-browser url)
    145           (rlet ((pdocattrs :id +null-ptr+)
    146                  (perror :id  +null-ptr+))
    147             (let* ((data (make-instance 'ns:ns-data
    148                            :with-contents-of-url url
    149                            :options 0
    150                            :error perror)))
    151               (if (not (%null-ptr-p (pref perror :id)))
    152                 (progn
    153                   (#/presentError: doc (pref perror :id)))
    154                 (let* ((string (make-instance 'ns:ns-attributed-string
    155                                  :with-html data
    156                                  :base-url url
    157                                  :document-attributes pdocattrs))
    158                        (docattrs (pref pdocattrs :id))
    159                        (title #+cocotron +null-ptr+
    160                               #-cocotron
    161                               (if (%null-ptr-p docattrs)
    162                                 +null-ptr+
    163                                 (#/objectForKey: docattrs #&NSTitleDocumentAttribute))))
    164                   (if (%null-ptr-p title)
    165                     (setq title (%make-nsstring (string symbol))))
    166                   (#/newDisplayDocumentWithTitle:content:
    167                    (#/sharedDocumentController ns:ns-document-controller)
    168                    title
    169                    string))))))))))
     186            (ccl::%open-url-in-browser url)
     187            (open-cocoa-window-with-url url (string symbol) (lambda (errptr) (#/presentError: doc errptr))
     188                                        ))))))
    170189                             
    171 
    172 
     190#+IGNORE
     191(gui::queue-for-gui (lambda () (open-cocoa-window-with-url (http-url "http://www.google.com/"))))
     192
     193#+IGNORE
     194(gui::queue-for-gui (lambda () (open-cocoa-window-with-url
     195                                (pathname-to-file-url "ccl:doc;ccl-documentation.html"))))
    173196                   
    174197                   
Note: See TracChangeset for help on using the changeset viewer.